$CONTROL MAP,CODE,USLINIT,LINES=120                                     00005000
$control map,code,uslinit,define                               <<06613>>00010000
<<kernelc : module 92>>                                        <<01715>>00015000
<< hp32002c mpe source c.00.00 >>                                       00020000
<< COPYRIGHT     "(C) COPYRIGHT HEWLETT-PACKARD CO. 1980.           >>  00025000
<<     this program may be used with one computer system at a       >>  00030000
<<     time and shall not otherwise be recorded, transmitted or     >>  00035000
<<     stored in a retrieval system.  copying or other reproduction >>  00040000
<<     of this program except for archival purposes is prohibited   >>  00045000
<<     without the prior written consent of hewlett-packard company.>>  00050000
<< **** note - dollar copyright cannot be used with this module *** >>  00055000
$control privileged, segment=kernelc, main=kernelc                      00060000
$control define                                                <<06945>>00065000
                                                                        00070000
begin                                                                   00075000
$include inclstdd                                              <<06212>>00080000
array stack(*)=q+0,qarray(*)=q+0;                              <<06635>>00085000
                                                               <<03041>>00090000
define globaltraceflag = absolute(%1267)#;                     <<03041>>00095000
define mempressure'cell = absolute(%1350).(0:1)#;              <<*7766>>00100000
                                                               <<03041>>00105000
                                                                        00110000
<<                                                                      00115000
sysglob cells                                                           00120000
>>                                                                      00125000
                                                                        00130000
                                                                        00135000
equate sysbase=%1000,                                                   00140000
       sysglobextix=%377,                                      <<06945>>00145000
       sysglobextbase=sysglobextix+sysbase,                    <<06945>>00150000
       slix=1,                                                          00155000
       syssl=sysbase+slix,                                              00160000
       dstix=2,                                                         00165000
       sysdst=sysbase+dstix,                                            00170000
       pcbix=3,                                                         00175000
       syspcb=sysbase+pcbix,                                            00180000
       icsix=7,                                                         00185000
       sysics=sysbase+icsix,                                            00190000
       lpdtix=%10,                                                      00195000
       syslpdt=sysbase+lpdtix,                                          00200000
       bptix = %25,                                            <<06948>>00205000
       sysbpt=sysbase+bptix,                                            00210000
       trlix=%12,                                                       00215000
       systrl=sysbase+trlix,                                            00220000
       jcutix=%13,                                             <<06942>>00225000
       staticfenceix=%27,                                      <<06945>>00230000
       sysstaticfence=sysbase+staticfenceix,                   <<06945>>00235000
       dfcix=%32,                                                       00240000
       sysdfc=sysbase+dfcix,                                            00245000
       dfsix=%33,                                                       00250000
       sysdfs=sysbase+dfsix,                                            00255000
       specreqtabix=%42,                                                00260000
       specqheadix=%43,                                                 00265000
       holecountix=%44,                                        <<06945>>00270000
       sysholecount=sysbase+holecountix,                       <<06945>>00275000
       holelistheadix=%250,                                    <<06945>>00280000
       sysholelisthead=sysbase+holelistheadix,                 <<06945>>00285000
       holelisttailix=%252,                                    <<06945>>00290000
       sysholelisttail=sysbase+holelisttailix,                 <<06945>>00295000
       nbanksix=%47,                                                    00300000
       sysnbanks=sysbase+nbanksix,                                      00305000
       maxavailregix=%45,                                               00310000
       sysmaxavailreg=sysbase+maxavailregix,                            00315000
       dispawakemsgix=%50,                                              00320000
       sysdispawakemsg=sysbase+dispawakemsgix,                          00325000
       cstxblkix=%51,                                                   00330000
       syscstxblk=sysbase+cstxblkix,                                    00335000
       awakeschedmsgix=%52,                                             00340000
       sysawakeschedmsgix=sysbase+awakeschedmsgix,                      00345000
       waitdispmsgix=%53,                                               00350000
       syswaitdispmsg=sysbase+waitdispmsgix,                            00355000
       curractpriix=%54,                                                00360000
       syscurractpri=sysbase+curractpriix,                              00365000
       sysmappingfirmware=sysbase+%220,                        <<06104>>00370000
       sysmapsegbank=sysbase+%221,                             <<06104>>00375000
       sysmapsegadr=sysbase+%222,                              <<06104>>00380000
       sysnrpgmsegs=sysbase+%223,                              <<06104>>00385000
       dispqheadix=%271,                                                00390000
       sysdispqhead=sysbase+dispqheadix,                                00395000
       dispqtailix=%272,                                                00400000
       sysdispqtail=sysbase+dispqtailix,                                00405000
       bugcatchix=%355,                                                 00410000
       sysbugcatch=sysbase+bugcatchix,                                  00415000
       lastbankix=%361,                                                 00420000
       syslastbank=sysbase+lastbankix,                                  00425000
       lastbaseix=%362,                                                 00430000
       syslastbase=sysbase+lastbaseix;                         <<06945>>00435000
                                                                        00440000
<<                                                                      00445000
sysglob cells for direct db-rel access                                  00450000
>>                                                                      00455000
                                                                        00460000
integer pcbsysbaseinx=db+pcbix,                                         00465000
        dstsysbaseinx=db+dstix,                                         00470000
        holecount=db+holecountix,                              <<06945>>00475000
        dfc=db+dfcix,                                                   00480000
        dfs=db+dfsix,                                                   00485000
        icssysbaseinx=db+icsix,                                         00490000
        slsysbaseinx=db+slix,                                           00495000
        staticmplfence=db+staticfenceix,                       <<06945>>00500000
        specqhead=db+specqheadix,                                       00505000
        maxavailreg=db+maxavailregix,                                   00510000
        nbanks=db+nbanksix,                                             00515000
        cstxblksysbaseinx=db+cstxblkix,                                 00520000
        dispqhead=db+dispqheadix,                                       00525000
        dispqtail=db+dispqtailix;                                       00530000
                                                                        00535000
logical disptoawakemsg=db+dispawakemsgix,                               00540000
        curractpri=db+curractpriix,                                     00545000
        awaketoschedmsg=db+awakeschedmsgix,                             00550000
        bugcatch=db+bugcatchix,                                         00555000
        waittodispmsg=db+waitdispmsgix;                                 00560000
                                                                        00565000
equate firstmemix=%20,                                                  00570000
       timelastcycix=%22,                                               00575000
       scanpointix=%265,                                                00580000
       lastcycdurix=%351,                                               00585000
       cyclethreshix=%353;                                              00590000
double scanpoint=db+scanpointix,                                        00595000
       firstmemaddr=db+firstmemix,                                      00600000
       lastmemoryaddress=db+lastbankix,                        <<06945>>00605000
       timeoflastcycle=db+timelastcycix,                                00610000
       cyclethreshold=db+cyclethreshix,                                 00615000
       lastcycleduration=db+lastcycdurix;                               00620000
                                                               <<06104>>00625000
define mappingfirmware = abs(sysmappingfirmware)#;             <<06104>>00630000
                                                                        00635000
   define free'phy'cst'head = absolute (%1225)#,               <<06282>>00640000
          total'phy'cst'num = absolute (%1224)#;               <<06282>>00645000
   equate cstsize = 4;                                         <<06282>>00650000
                                                               <<06282>>00655000
                                                                        00660000
                                                                        00665000
<<                                                                      00670000
table pointers (lst access)                                             00675000
>>                                                                      00680000
                                                                        00685000
integer pointer sl=slix,                                                00690000
                dst=dstix,                                              00695000
                pcb=pcbix,                                              00700000
                lpdt=lpdtix,                                            00705000
                specreqtab=specreqtabix,                                00710000
                cstxblk=cstxblkix,                                      00715000
                ics=icsix,                                              00720000
                jcutarr=jcutix,                                <<06942>>00725000
                sysglobext=sysglobextix;                                00730000
                                                                        00735000
                                                                        00740000
<<                                                                      00745000
sysglob extension assignents                                            00750000
>>                                                                      00755000
                                                                        00760000
double array                                                   <<06945>>00765000
   holelisthead(*) = db + holelistheadix,                      <<06945>>00770000
   holelisttail(*) = db + holelisttailix;                      <<06945>>00775000
                                                                        00780000
define garbcollenabled=sysglobext(3)#,                                  00785000
       firstmembank=sysglobext(1)#,                                     00790000
       firstmembase=sysglobext(2)#,                                     00795000
       memorypagesize=sysglobext(5)#,                                   00800000
       vdspagesize=sysglobext(6)#,                                      00805000
       hotimelastmakeroom=sysglobext(7)#,                               00810000
       lotimelastmakeroom=sysglobext(8)#,                               00815000
       mempressdurext=sysglobext(9)#,                                   00820000
       movethreshold=sysglobext(4)#;                                    00825000
                                                                        00830000
                                                                        00835000
                                                                        00840000
<< lpdt defines >>                                             <<06675>>00845000
                                                               <<06675>>00850000
equate lpdt'ditp = 2;    << dit pointer from the lpdt >>       <<06675>>00855000
                                                               <<06675>>00860000
<<                                                                      00865000
standard system tables entry allocation                                 00870000
>>                                                                      00875000
                                                                        00880000
logical array systabentry(*) = db + 0;                         <<06620>>00885000
double array dsystabentry01(*) = db + 1;                       <<06620>>00890000
logical array systabentry00(*)=db+0,                                    00895000
              systabentry01(*)=db+1,                                    00900000
              systabentry02(*)=db+2,                                    00905000
              systabentry03(*)=db+3,                                    00910000
              systabentry04(*)=db+4,                                    00915000
              systabentry05(*)=db+5,                                    00920000
              systabentry16(*)=db+16;                                   00925000
                                                                        00930000
define entryword00=systabentry00(x)#,                                   00935000
       entryword01=systabentry01(x)#,                                   00940000
       dentryword01=dsystabentry01(x)#,                        <<06620>>00945000
       entryword02=systabentry02(x)#,                                   00950000
       entryword03=systabentry03(x)#,                                   00955000
       entryword04=systabentry04(x)#,                                   00960000
       entryword05=systabentry05(x)#;                                   00965000
                                                                        00970000
$include incsytab                                              <<06616>>00975000
                                                               <<01987>>00980000
define totaldiscreqcnt=systabentry00(x).(0:8)#,                <<01987>>00985000
       inusediscreqcnt=systabentry04(x).(8:8)#;                <<01987>>00990000
                                                               <<06616>>00995000
                                                               <<01987>>01000000
$include inclsir                                               <<06264>>01005000
$include inclobj                                               <<06411>>01010000
$include inclst                                                         01015000
$include inclsll                                                        01020000
$include inclpcb5                                              <<06650>>01025000
$include inclpcbx                                              <<06212>>01030000
$include inclics                                                        01035000
$include inclsf                                                <<06411>>01040000
$include inclpxdl                                              <<*7765>>01045000
$include inclpxft                                              <<*7765>>01050000
$include inclmmst                                              <<06212>>01055000
$include inclreg                                               <<06212>>01060000
$include inclmsg                                                        01065000
                                                                        01070000
$include incldqh                                               <<06392>>01075000
$include inclioq                                               <<06392>>01080000
$include inclknio                                              <<06392>>01085000
$include incldrq                                               <<06392>>01090000
$include inclcdef                                              <<06212>>01095000
$include inclldr                                               <<06948>>01100000
                                                                        01105000
<<                                                                      01110000
breakpoint table                                                        01115000
>>                                                             <<mm.iv>>01120000
                                                               <<mm.iv>>01125000
equate bkpt'flag      = sysbpt,                                <<mm.iv>>01130000
       bpt'dst        = %36,                                   <<mm.iv>>01135000
       bpt'dst'ind    = bpt'dst*4,                             <<mm.iv>>01140000
       sys'bkpt'ext'x = 1;        <<index of head of sys list>><<mm.iv>>01145000
                                                               <<mm.iv>>01150000
define sys'bkpt       = absolute(bkpt'flag).(15:1)#,           <<mm.iv>>01155000
       bpt'tab'locked = absolute(bkpt'flag).(14:1)#,           <<mm.01>>01160000
       bkpt'valid     = (3:1)#,                                <<06104>>01165000
      bkpt'updating   = (10:1)#;                               <<mm.01>>01170000
                                                               <<mm.iv>>01175000
integer array bpt(*)  = db+0;                                  <<mm.iv>>01180000
double  array dbpt(*)  = db+0;                                 <<06660>>01185000
                                                               <<mm.iv>>01190000
equate   userlblmodeoffset=1,                                  <<06104>>01195000
         clabeloffset     =2,<<word 2 & 3 resevered for segid>><<06660>>01200000
         plocoffset       =4,                                  <<06104>>01205000
         instroffset      =5,                                  <<06104>>01210000
         linkoffset       =6,                                  <<06104>>01215000
         userlbloffset    =7;                                  <<06104>>01220000
                                                                        01225000
<<                                                                      01230000
misc                                                                    01235000
>>                                                                      01240000
                                                                        01245000
equate pagepower=7, <<8>> <<9>>                                         01250000
                                                               <<06212>>01255000
       maxholesize=512, <<256>> <<128>>                                 01260000
       arsbmlength=maxholesize/16+1,                                    01265000
       arldlength=maxholesize*2+2,                                      01270000
       cstxbmwrdcnt=4;                                         <<06625>>01275000
                                                                        01280000
$include inclparm                                              <<06212>>01285000
                                                               <<04663>>01290000
<< the following defines are used to support privileged    >>  <<04663>>01295000
<< mode bounds checking. get'xdseg'limits transfers the    >>  <<04663>>01300000
<< bank, base address, and limit address to ics qi minus   >>  <<04663>>01305000
<< area. the index register is expected to be pointing to  >>  <<04663>>01310000
<< dst entry, word 0.                                      >>  <<04663>>01315000
                                                               <<04663>>01320000
define  get'xdseg'limits=                                      <<04663>>01325000
                                                               <<04663>>01330000
  begin                                                        <<04663>>01335000
  tos:= x;                    << save index reg >>             <<04663>>01340000
  tos:= dst(x:= x+2);         << get xdseg bank num >>         <<04663>>01345000
  tos:= dst(x:= x+1);         << get xdseg base addr >>        <<04663>>01350000
  asmb(dup);                  << copy xdseg base addr >>       <<04663>>01355000
  tos:= (dst(x:= x-3).(3:13) & lsl(2)) + tos;                  <<04663>>01360000
  ics(- ics'xdseglimcell):= tos;    << ics gets xdseg limt >>  <<04663>>01365000
  ics(- ics'xdsegbasecell):= tos;   << ics gets xdseg base >>  <<04663>>01370000
  ics(- ics'xdsegbnkcell):= tos;    << ics gets xdseg bank >>  <<04663>>01375000
  x:= tos;                          << restore index reg. >>   <<04663>>01380000
  end#;                                                        <<04663>>01385000
                                                               <<04663>>01390000
define  xfer'xdseg'limits=                                     <<04663>>01395000
                                                               <<04663>>01400000
  tos:= 2;                                                     <<04663>>01405000
  asmb(sbl)#;                     << cpu reg get xdseg info >> <<04663>>01410000
                                                               <<04663>>01415000
define   cpunum= asmb(pcn)#,         << get cpu number >>      <<04663>>01420000
         sbf   = con %20104, %11#,   << set bounds flag >>     <<04663>>01425000
         sbl   = con %20104, %12#;   << set bounds limits >>   <<04663>>01430000
                                                               <<04663>>01435000
equate series64    = 4;                                        <<04663>>01440000
                                                               <<04663>>01445000
<< pcbx'bndsinfo gets the current pcbx bank and address.   >>  <<04663>>01450000
<< get'pcbxbnds'flag transfers the bounds checking status  >>  <<04663>>01455000
<< word found in the pcbx to the ics qi minus area.        >>  <<04663>>01460000
<< update'pcbxbnds'flag transfers the bounds status word   >>  <<04663>>01465000
<< found in the ics qi minus area to the pcbx. tos should  >>  <<04663>>01470000
<< contain the pcbx bound status word, bank, and base of   >>  <<04663>>01475000
<< the pcbx.                                               >>  <<04663>>01480000
                                                               <<04663>>01485000
define pcbx'bndsinfo =                                         <<04663>>01490000
                                                               <<04663>>01495000
       tos:= x;                     << save index reg >>       <<04663>>01500000
       tos:= ics'stkbank;           << get stack bank num >>   <<04663>>01505000
       tos:= ics'stkbase+ sbtopmbndstat;                       <<04663>>01510000
       << get stack base address and add offset >>             <<04663>>01515000
                                                               <<04663>>01520000
       asmb(lsea)#;                                            <<04663>>01525000
                                                               <<04663>>01530000
define get'pcbxbnds'flag =                                     <<04663>>01535000
                                                               <<04663>>01540000
       begin                                                   <<04663>>01545000
       pcbx'bndsinfo;                                          <<04663>>01550000
       tos:= tos.(0:2);                                        <<04663>>01555000
       ics(-ics'pmbndstatcell).(14:2):= tos;                   <<04663>>01560000
       ics(-ics'xdsegbnkcell):= -1;                            <<04663>>01565000
       asmb(ddel);                                             <<04663>>01570000
       x:= tos;                                                <<04663>>01575000
       end#;                                                   <<04663>>01580000
                                                               <<04663>>01585000
define update'pcbxbnds'flag =                                  <<04663>>01590000
                                                               <<04663>>01595000
       begin                                                   <<04663>>01600000
       pcbx'bndsinfo;                                          <<04663>>01605000
       tos.(0:2):= ics(-ics'pmbndstatcell).(14:2);             <<04663>>01610000
       asmb(ssea;ddel);                                        <<04663>>01615000
       x:= tos;                                                <<04663>>01620000
       end#;                                                   <<04663>>01625000
                                                               <<04663>>01630000
define update'ics'xdsegbnkcell =                               <<04663>>01635000
                                                               <<04663>>01640000
       begin                                                   <<04663>>01645000
       absolute(absolute (5)- ics'xdsegbnkcell):= -1;          <<04663>>01650000
       xfer'xdseg'limits;                                      <<04663>>01655000
       end#;                                                   <<04663>>01660000
                                                               <<04663>>01665000
                                                                        01670000
equate softswap=false,   <<swapin's effort control parameter>> <<01987>>01675000
       hardswap=true;                                          <<01987>>01680000
                                                               <<01987>>01685000
equate mmok=0,  <<mem management status returns>>              <<01987>>01690000
       mmpreempt=4,                                            <<01987>>01695000
       mmioerr=5,                                              <<01987>>01700000
       mmsegbusy=6,                                            <<01987>>01705000
       mmthrashdanger=7,                                       <<01987>>01710000
       mmnolockspace=8,                                        <<01987>>01715000
       mmoutofdiscreq=9;                                       <<01987>>01720000
                                                               <<01987>>01725000
                                                               <<06212>>01730000
<<some qualifiers for mmstat parameters>>                      <<06212>>01735000
                                                               <<06212>>01740000
equate                                                         <<06212>>01745000
                                                               <<06212>>01750000
   <<mmstatfetch event parameter 3>>                           <<06212>>01755000
                                                               <<06212>>01760000
   mmstatpres   = 0,                                           <<06212>>01765000
   mmstatroc    = 1,                                           <<06212>>01770000
   mmstatimi    = 2,                                           <<06212>>01775000
   mmstatfullfetch = 3;                                        <<06212>>01780000
                                                               <<01987>>01785000
$include inclmeas                                                       01790000
                                                               <<04109>>01795000
$include inclmift                                              <<04109>>01800000
$include incljcut                                              <<06942>>01805000
$page "SOFT INTERRUPT GLOBAL DEFINES."                         <<03041>>01810000
$include incltrl                                               <<06943>>01815000
                                                               <<03041>>01820000
                                                               <<03041>>01825000
equate                                                         <<03041>>01830000
   uglypseudoint  = 4,                                         <<03041>>01835000
   maxmsglen      = 4,                                         <<03041>>01840000
   deletemsg      = 0,                                         <<03041>>01845000
   savemsg        = %100000;                                   <<03041>>01850000
                                                               <<03041>>01855000
                                                               <<03041>>01860000
                                                               <<03041>>01865000
equate  <<mmstat mmstate pseudo-interrupt numbers>>            <<03041>>01870000
   hardkiller      = 0,                                        <<03041>>01875000
   softkiller      = 1,                                        <<03041>>01880000
   controly        = 2,                                        <<03041>>01885000
   breaker         = 3,                                        <<03041>>01890000
   sysoftint       = 4,                                        <<03041>>01895000
   usersoftint     = 5;                                        <<03041>>01900000
                                                               <<03041>>01905000
equate  <<pseudo-interrupt values>>                            <<03041>>01910000
   hardkillvalue  = 1,                                         <<03041>>01915000
   softkillvalue  = 2,                                         <<03041>>01920000
   stopvalue      = 3,                                         <<03041>>01925000
   hybernatevalue = 4,                                         <<03041>>01930000
   controlyvalue  = 5,                                         <<03041>>01935000
   breakvalue     = 6,                                         <<03041>>01940000
   normalvalue    = 7;                                         <<03041>>01945000
                                                               <<03041>>01950000
equate  <<return values of timeout procedure>>                 <<03041>>01955000
   timeoutoccurred= 0,                                         <<03041>>01960000
   trlxexhausted  = 1,                                         <<03041>>01965000
   softintoccurred= 2;                                         <<03041>>01970000
                                                               <<03041>>01975000
equate                                                         <<03041>>01980000
   usermsgport    = 1,                                         <<03041>>01985000
   systemsgport   = 2;                                         <<03041>>01990000
                                                               <<k7563>>01995000
procedure soft'death(which);                                   <<k7563>>02000000
   value which;                                                <<k7563>>02005000
   integer which;                                              <<k7563>>02010000
   option external;                                            <<k7563>>02015000
                                                               <<06947>>02020000
procedure sendmsg(destpin,destportnum,msglength,flags);        <<06947>>02025000
value destpin,destportnum,msglength,flags;                     <<06947>>02030000
integer destpin,destportnum,msglength;                         <<06947>>02035000
logical flags;                                                 <<06947>>02040000
option external;                                               <<06947>>02045000
                                                               <<06947>>02050000
integer procedure portstatus(portnumber);                      <<06947>>02055000
value portnumber;                                              <<06947>>02060000
integer portnumber;                                            <<06947>>02065000
option external;                                               <<06947>>02070000
                                                               <<06947>>02075000
procedure receivemsg(portnum,msglength,flags);                 <<06947>>02080000
value portnum,msglength,flags;                                 <<06947>>02085000
integer portnum,msglength;                                     <<06947>>02090000
logical flags;                                                 <<06947>>02095000
option external;                                               <<06947>>02100000
                                                               <<06947>>02105000
procedure portseg'completor(req'id);                           <<06947>>02110000
value req'id;                                                  <<06947>>02115000
integer req'id;                                                <<06947>>02120000
option external;                                               <<06947>>02125000
$include inclcimp                                              <<06212>>02130000
$include inclioim                                              <<06212>>02135000
$include inclmimp                                              <<06212>>02140000
$page "Exportable Forward Procedure Declarations"              <<06212>>02145000
                                                               <<06212>>02150000
integer procedure convextlabeltodeltap(extlabel);              <<03041>>02155000
value extlabel;                                                <<03041>>02160000
integer extlabel;                                              <<03041>>02165000
option forward;                                                <<03041>>02170000
                                                                        02175000
double  procedure buildsegid(segtype,segno,pin);               <<06660>>02180000
   value segtype,segno,pin;                                    <<06104>>02185000
   integer segtype,segno,pin;                                  <<06104>>02190000
   option forward;                                             <<06104>>02195000
                                                               <<06104>>02200000
integer procedure convsegidtostinx(segid);                     <<06104>>02205000
   value segid;                                                <<06104>>02210000
   double  segid;                                              <<06660>>02215000
   option forward;                                             <<06104>>02220000
                                                               <<06104>>02225000
integer procedure cstconv(plabel,pcbpt);                       <<06104>>02230000
   value plabel,pcbpt;                                         <<06104>>02235000
   integer plabel,pcbpt;                                       <<06104>>02240000
   option forward;                                             <<06104>>02245000
                                                               <<06104>>02250000
double  procedure mappedcsttophycst(plabel,pcbpt);             <<06660>>02255000
   value plabel,pcbpt;                                         <<06104>>02260000
   integer plabel,pcbpt;                                       <<06104>>02265000
   option forward;                                             <<06104>>02270000
                                                               <<06104>>02275000
procedure awake (pcbpt,wakecode,waitflags);                             02280000
value pcbpt,wakecode,waitflags;                                         02285000
integer pcbpt,waitflags;                                                02290000
logical wakecode;                                                       02295000
option forward;                                                         02300000
                                                                        02305000
procedure impede(pcbpt);                                                02310000
value pcbpt;                                                            02315000
integer pcbpt;                                                          02320000
option forward;                                                         02325000
                                                                        02330000
procedure unimpede(pcbpt);                                              02335000
value pcbpt;                                                            02340000
integer pcbpt;                                                          02345000
option forward;                                                         02350000
                                                                        02355000
procedure queueproc(procsysdbinx,queuename,location);                   02360000
value procsysdbinx,queuename,location;                                  02365000
integer procsysdbinx,queuename,location;                                02370000
option forward;                                                         02375000
                                                                        02380000
procedure iofreeze'(objident);                                 <<06212>>02385000
value objident;                                                <<06212>>02390000
double  objident;                                              <<06660>>02395000
option forward;                                                         02400000
                                                                        02405000
procedure iounfreeze'(objident);                               <<06212>>02410000
value objident;                                                <<06212>>02415000
double  objident;                                              <<06660>>02420000
option forward;                                                         02425000
logical procedure setsysdb;                                    <<06616>>02430000
option forward;                                                <<06616>>02435000
                                                               <<06616>>02440000
procedure resetdb(where);                                      <<06616>>02445000
value where;                                                   <<06616>>02450000
integer where;                                                 <<06616>>02455000
option forward;                                                <<06616>>02460000
                                                               <<06616>>02465000
logical procedure exchangedb(where);                           <<06616>>02470000
value where;                                                   <<06616>>02475000
integer where;                                                 <<06616>>02480000
option forward;                                                <<06616>>02485000
                                                               <<06616>>02490000
                                                               <<06212>>02495000
procedure queueonobject(objident);                             <<06212>>02500000
value objident;                                                <<06212>>02505000
double  objident;                                              <<06660>>02510000
option forward;                                                <<06212>>02515000
                                                               <<06212>>02520000
procedure wait(eventmask,specialinfo);                         <<06212>>02525000
value eventmask,specialinfo;                                   <<06212>>02530000
integer eventmask;                                             <<06212>>02535000
logical specialinfo;                                           <<06212>>02540000
option forward;                                                <<06212>>02545000
                                                               <<06212>>02550000
procedure addtolocality(sllheadinx,objidentifier,flags);       <<06660>>02555000
value sllheadinx,objidentifier,flags;                          <<06660>>02560000
integer sllheadinx,flags;                                      <<06660>>02565000
double objidentifier;                                          <<06660>>02570000
option forward;                                                <<06212>>02575000
                                                               <<06212>>02580000
procedure prefetchobject(pin, objid);                          <<06212>>02585000
value pin, objid;                                              <<06212>>02590000
integer pin;                                                   <<06212>>02595000
double  objid;                                                 <<06660>>02600000
option forward;                                                <<06212>>02605000
                                                               <<06212>>02610000
procedure adjustlocality(procinx,objident,reqsize,flags);      <<06212>>02615000
value procinx,objident,reqsize,flags;                          <<06212>>02620000
logical procinx,reqsize,flags;                                 <<06660>>02625000
double objident;                                               <<06660>>02630000
option forward;                                                <<06212>>02635000
                                                               <<06212>>02640000
logical procedure setcritical;                                 <<06212>>02645000
option forward;                                                <<06212>>02650000
                                                               <<06212>>02655000
procedure resetcritical(oldcritical);                          <<06212>>02660000
value oldcritical;                                             <<06212>>02665000
                                                               <<06212>>02670000
logical oldcritical;                                           <<06212>>02675000
option forward;                                                <<06212>>02680000
                                                               <<06212>>02685000
procedure releaseregion(regionbase,reqsize);                   <<06212>>02690000
value regionbase,reqsize;                                      <<06212>>02695000
double regionbase;                                             <<06212>>02700000
integer reqsize;                                               <<06212>>02705000
option forward;                                                <<06212>>02710000
                                                               <<06212>>02715000
procedure startobjwrite(objid,urgclass,regionbase,logxferreq,  <<06212>>02720000
                        discreqinx);                           <<06212>>02725000
value objid,urgclass,regionbase,logxferreq,discreqinx;         <<06212>>02730000
double  objid;                                                 <<06660>>02735000
integer urgclass,logxferreq,discreqinx;                        <<06212>>02740000
double regionbase;                                             <<06212>>02745000
option forward;                                                <<06212>>02750000
                                                               <<06212>>02755000
procedure recoveroc (objid,segdescstinx, ocregionbase);        <<06212>>02760000
value objid, segdescstinx, ocregionbase;                       <<06212>>02765000
double ocregionbase,objid;                                     <<06660>>02770000
integer segdescstinx;                                          <<06660>>02775000
option forward;                                                <<06212>>02780000
                                                               <<06212>>02785000
$page "Non-Exportable Forward Declarations"                    <<06212>>02790000
                                                               <<06212>>02795000
procedure collectgarbage(singleholebase);                      <<06212>>02800000
value singleholebase;                                          <<06212>>02805000
double singleholebase;                                         <<06212>>02810000
option forward;                                                <<06212>>02815000
                                                               <<06212>>02820000
procedure processinitmsg(regionbase);                          <<06212>>02825000
value regionbase;                                              <<06212>>02830000
double regionbase;                                             <<06212>>02835000
option forward;                                                <<06212>>02840000
                                                               <<06212>>02845000
                                                               <<06212>>02850000
                                                               <<06212>>02855000
procedure processcompmsg(regionbase,objident,descstinx,iostat);<<06212>>02860000
value regionbase,objident,descstinx,iostat;                    <<06212>>02865000
double regionbase;                                             <<06212>>02870000
double  objident;                                              <<06660>>02875000
integer descstinx,iostat;                                      <<06212>>02880000
option forward;                                                <<06212>>02885000
                                                               <<06212>>02890000
                                                               <<06212>>02895000
integer procedure swapin(swapinprocinx,swapinstructions);      <<06411>>02900000
value swapinprocinx,swapinstructions;                          <<06411>>02905000
integer swapinprocinx;                                         <<06411>>02910000
logical swapinstructions;                                      <<06411>>02915000
option forward;                                                <<06411>>02920000
                                                               <<06212>>02925000
$page "MMSTAT : EVENT TRACE GENERATOR"                         <<06212>>02930000
                                                               <<06212>>02935000
<<*************************************************************<<06212>>02940000
                                                               <<06212>>02945000
comment  this function is called to monitor and/or collect     <<06212>>02950000
         performance measurement data;                         <<06212>>02955000
procedure mmstat'(event,p1,p2,p3,p4,p5,p6);                    <<06948>>02960000
value event,p1,p2,p3,p4,p5,p6;                                 <<06948>>02965000
integer event,p1,p2,p3,p4,p5,p6;                               <<06948>>02970000
option         privileged,uncallable;                          <<01658>>02975000
                                                               <<01658>>02980000
                                                               <<01658>>02985000
begin <<mmstat>>                                               <<01658>>02990000
                                                               <<01658>>02995000
integer                                                        <<06948>>03000000
   pcbpt,                                                      <<06948>>03005000
   offset;                                                     <<06948>>03010000
double                                                         <<06948>>03015000
   base,                                                       <<06948>>03020000
   save'db;                                                    <<06948>>03025000
                                                               <<01658>>03030000
intrinsic        timer;                 <<time function>>      <<01658>>03035000
$page "SYSTEM TABLE MANAGEMENT : GET SYSTAB ENTRY"                      03040000
                                                               <<01658>>03045000
                                                               <<01658>>03050000
                                                               <<01658>>03055000
double subroutine convert'pointer'to'double'address(ptr);      <<06948>>03060000
value ptr;                                                     <<06948>>03065000
logical ptr;                                                   <<06948>>03070000
begin                                                          <<06948>>03075000
                                                               <<06948>>03080000
tos := abs(sysbase + ptr).(11:5); << extract bank >>           <<06948>>03085000
tos := abs(x) land %177740; << extract address >>              <<06948>>03090000
base := tos;                                                   <<06948>>03095000
convert'pointer'to'double'address := base;                     <<06948>>03100000
                                                               <<06948>>03105000
end; << subrouine convert'pointer'to'double'address >>         <<06948>>03110000
                                                               <<06948>>03115000
<< if a process is executing, get its pin >>                   <<01658>>03120000
                                                               <<01658>>03125000
pcbpt := curprc;                                               <<06948>>03130000
                                                               <<01658>>03135000
                                                               <<01658>>03140000
<< if the event number is positive then >>                     <<01658>>03145000
<<                                      >>                     <<01658>>03150000
<<      check event validity            >>                     <<01658>>03155000
<<      disable interrupts              >>                     <<01658>>03160000
<<      xchd to sysdb                   >>                     <<01658>>03165000
<<      log the event to monbuf         >>                     <<01658>>03170000
<<                                      >>                     <<01658>>03175000
<< if the event number is negative then >>                     <<01658>>03180000
<<                                      >>                     <<01658>>03185000
<<      make it positive                >>                     <<01658>>03190000
<<      check its validity              >>                     <<01658>>03195000
<<      disable interrupts              >>                     <<01658>>03200000
<<      xchd to sysdb                   >>                     <<01658>>03205000
                                                               <<01658>>03210000
                                                               <<01658>>03215000
                                                               <<01658>>03220000
                                                               <<01658>>03225000
<<  turn off traps >>                                          <<04442>>03230000
push(status);                                                  <<04442>>03235000
tos.(2:1) := 0;                                                <<04442>>03240000
set(status);                                                   <<04442>>03245000
                                                               <<01658>>03250000
tos := event;                                                  <<01658>>03255000
                                                               <<01658>>03260000
if >= then                                                     <<01658>>03265000
                                                               <<01658>>03270000
  begin <<positive event>>                                     <<01658>>03275000
                                                               <<01658>>03280000
  if event > maxeventnumber then                               <<06948>>03285000
     return;                                                   <<06948>>03290000
                                                               <<*8487>>03295000
  disable;                                                     <<*8487>>03300000
  push(z); push(s); assemble(sub);                             <<01934>>03305000
                                                               <<01658>>03310000
  if tos<34 then return; <<mmstat cant stand a stack overflow>><<*8487>>03315000
                                                               <<01658>>03320000
  tos := sysbase d;                                            <<06948>>03325000
                                                               <<01658>>03330000
  assemble(xchd);                                              <<01658>>03335000
  save'db := tos;                                              <<06948>>03340000
                                                               <<01658>>03345000
                                                               <<01658>>03350000
                                                               <<01658>>03355000
<< save procinx, event, and parms into monbuf >>               <<06948>>03360000
                                                               <<01658>>03365000
  smonbuf(smondix) := pcbpt;                                   <<06948>>03370000
  smonbuf(x := x + 1) := event;                                <<06948>>03375000
  smonbuf(x:=x+1)  := p1;                                      <<01658>>03380000
  smonbuf(x:=x+1)  := p2;                                      <<01658>>03385000
  smonbuf(x:=x+1)  := p3;                                      <<01658>>03390000
  smonbuf(x := x + 1) := p4;                                   <<06948>>03395000
  smonbuf(x := x + 1) := p5;                                   <<06948>>03400000
  smonbuf(x := x + 1) := p6;                                   <<06948>>03405000
                                                               <<06948>>03410000
                                                               <<06948>>03415000
                                                               <<01658>>03420000
                                                               <<01658>>03425000
<< if the end of the buffer has been reached, >>               <<01658>>03430000
<< set the buffer index to the start of the   >>               <<01658>>03435000
<< buffer and reset the time stamps in the    >>               <<01658>>03440000
<< first entry.  this entry contains two time >>               <<01658>>03445000
<< time stamps indicating the last two times  >>               <<01658>>03450000
<< wrap around has occured.  time stamps are  >>               <<01658>>03455000
<< two words in length.                       >>               <<01658>>03460000
                                                               <<01658>>03465000
                                                               <<01658>>03470000
   if (smondix := smondix + smon'entry'size) >=                <<06948>>03475000
       smonbufsize then                                        <<06948>>03480000
                                                               <<01658>>03485000
     begin <<monbuf wrap around>>                              <<01658>>03490000
                                                               <<01658>>03495000
     smondix := smon'entry'size;                               <<*8487>>03500000
     tos := timer;            <<get new time stamp>>           <<01658>>03505000
     tos := smonbuf(0);       <<get old time stamp>>           <<01658>>03510000
     tos := smonbuf(x:=x+1);                                   <<01658>>03515000
     smonbuf(x:=x+2) := tos;  <<save old time stamp>>          <<01658>>03520000
     smonbuf(x:=x-1) := tos;                                   <<01658>>03525000
     smonbuf(x:=x-1) := tos;  <<save new time stamp>>          <<01658>>03530000
     smonbuf(x:=x-1) := tos;                                   <<01658>>03535000
                                                               <<01658>>03540000
     end; <<monbuf wrap around>>                               <<01658>>03545000
                                                               <<01658>>03550000
  end <<positive event>>                                       <<01658>>03555000
                                                               <<01658>>03560000
else                                                           <<01658>>03565000
                                                               <<01658>>03570000
  begin <<negative event>>                                     <<01658>>03575000
                                                               <<01658>>03580000
  tos := -event;                                               <<01658>>03585000
                                                               <<01658>>03590000
  if (event := tos) > maxeventnumber then                      <<06948>>03595000
     return;                                                   <<06948>>03600000
                                                               <<01658>>03605000
  disable;                                                     <<01658>>03610000
  tos := sysbase d;                                            <<06948>>03615000
  assemble(xchd);                                              <<01658>>03620000
  save'db := tos;                                              <<06948>>03625000
                                                               <<01658>>03630000
  end; <<negative event>>                                      <<01658>>03635000
                                                               <<01658>>03640000
                                                               <<01658>>03645000
<< if a monitor run is requested then log the event >>         <<01658>>03650000
<< to the measbuf double buffer set and call measio >>         <<01658>>03655000
<< when a buffer is filled.                         >>         <<01658>>03660000
                                                               <<01658>>03665000
                                                               <<01658>>03670000
if (tos:=measflag) then                                        <<01658>>03675000
                                                               <<01658>>03680000
  begin <<measurement enabled>>                                <<01658>>03685000
                                                               <<01658>>03690000
                                                               <<01658>>03695000
<< compute the group id (modulo 10) and test its >>            <<01658>>03700000
<< corresponding measurement enable flag.        >>            <<01658>>03705000
                                                               <<01658>>03710000
                                                               <<01658>>03715000
  tos := event/10;                                             <<01658>>03720000
  assemble(trbc 11);                                           <<01658>>03725000
                                                               <<01658>>03730000
  tos := if = then meas'msk0 else meas'msk1;                   <<04109>>03735000
                                                               <<01658>>03740000
  assemble(stbx; tbc 0,x; ddel);                               <<01658>>03745000
                                                               <<01658>>03750000
                                                               <<01658>>03755000
                                                               <<01658>>03760000
<< if the event is enabled for montioring, dump it   >>        <<01658>>03765000
<< to the current measurement buffer.  if the buffer >>        <<01658>>03770000
<< is filled, call "MEASIO" to write the buffer to   >>        <<01658>>03775000
<< tape and switch to the other buffer.              >>        <<01658>>03780000
                                                               <<01658>>03785000
                                                               <<01658>>03790000
                                                               <<01658>>03795000
  if <> then                            <<test enable flag>>   <<01658>>03800000
                                                               <<01658>>03805000
     begin <<event enabled>>                                   <<01658>>03810000
                                                               <<01658>>03815000
     assemble(tbc 14);                  <<test group flag>>    <<01658>>03820000
     offset := if = then 0 else measbufsize;                   <<06948>>03825000
                                                               <<02725>>03830000
     tos := timer;                                             <<01658>>03835000
     assemble(xch);                                            <<01658>>03840000
     measbuf(integer(meas'idx) + offset) := tos;               <<06948>>03845000
     measbuf(x:=x+1)  := tos;                                  <<01658>>03850000
     measbuf(x := x + 1) := pcbpt;                             <<06948>>03855000
     measbuf(x:=x+1)  := event;                                <<01658>>03860000
     measbuf(x:=x+1)  := p1;                                   <<01658>>03865000
     measbuf(x:=x+1)  := p2;                                   <<01658>>03870000
     measbuf(x:=x+1)  := p3;                                   <<01658>>03875000
     measbuf(x := x + 1) := p4;                                <<06948>>03880000
     measbuf(x := x + 1) := p5;                                <<06948>>03885000
     measbuf(x := x + 1) := p6;                                <<06948>>03890000
                                                               <<01658>>03895000
     if (meas'idx := meas'idx + meas'entry'size) >=            <<06948>>03900000
         measbufsize then                                      <<06948>>03905000
                                                               <<01658>>03910000
        begin <<write buffer>>                                 <<01658>>03915000
                                                               <<01658>>03920000
        meas'idx := 0;                                         <<04109>>03925000
        assemble(tcbc 14; dup);   <<switch buffer flag>>       <<01658>>03930000
        measflag := tos;          <<save in case interrupted>> <<01658>>03935000
        tos := 0;                 <<result>>                   <<01658>>03940000
        tos := meas'ldev;         <<tape ldev>>                <<04109>>03945000
        tos := 1;                 <<measio write request>>     <<01658>>03950000
        tos := convert'pointer'to'double'address(measbufptr);  <<06948>>03955000
        tos := tos + offset;                                   <<06948>>03960000
        tos := measbufsize;       <<measbuf size>>             <<01658>>03965000
        tos := meas'plab;         <<measio plabel>>            <<04109>>03970000
                                                               <<02725>>03975000
        tos := sysbase d;                                      <<06948>>03980000
        assemble(xchd;ddel);                                   <<02725>>03985000
                                                               <<02725>>03990000
        assemble(pcal 0);         <<call measio>>              <<01658>>03995000
                                                               <<01658>>04000000
                                                               <<01658>>04005000
                                                               <<01658>>04010000
<< on return from "MEASIO", check the tape status  >>          <<01658>>04015000
<< and mark the appropriate measflag bit:          >>          <<01658>>04020000
<<          measflag(12:1) - tape error            >>          <<01658>>04025000
<<          measflag(13:1) - end of tape           >>          <<01658>>04030000
<<          measflag(14:1) - buffer select         >>          <<01658>>04035000
<<          measflag(15:1) - measio enable         >>          <<01658>>04040000
                                                               <<01658>>04045000
        del;                 <<delete tape status word>>       <<01658>>04050000
                                                               <<01658>>04055000
        if <> then           <<test tape status>>              <<01658>>04060000
                                                               <<01658>>04065000
           begin <<tape status>>                               <<01658>>04070000
                                                               <<01658>>04075000
           if > then tos.(13:1) := 1    <<end of tape>>        <<01658>>04080000
                else tos.(12:1) := 1;   <<tape error>>         <<01658>>04085000
                                                               <<01658>>04090000
           tos.(15:1) := 0;             <<clear measio enable>><<01658>>04095000
                                                               <<01658>>04100000
           end; <<tape status>>                                <<01658>>04105000
                                                               <<01658>>04110000
        end; <<write buffer>>                                  <<01658>>04115000
                                                               <<01658>>04120000
     end; <<event enabled>>                                    <<01658>>04125000
                                                               <<01658>>04130000
  measflag := tos;                 <<restore measflag>>        <<01658>>04135000
                                                               <<01658>>04140000
  end <<measurement enabled>>                                  <<01658>>04145000
                                                               <<01658>>04150000
                                                               <<01658>>04155000
else                                                           <<01658>>04160000
                                                               <<01658>>04165000
  del;                             <<delete measflag>>         <<01658>>04170000
                                                               <<01658>>04175000
tos := save'db;                                                <<06948>>04180000
assemble(xchd);                                                <<01658>>04185000
ddel;                                                          <<06948>>04190000
                                                               <<01658>>04195000
end; <<mmstat>>                                                <<01658>>04200000
                                                               <<06212>>04205000
$page "STANDARD SYSTEM TABLE ENTRY MANAGEMENT"                 <<06212>>04210000
                                                               <<06212>>04215000
logical procedure getsystabentry(tabledst,primary,wait);       <<06616>>04220000
value tabledst,primary,wait;                                   <<06616>>04225000
logical tabledst,primary,wait;                                 <<06616>>04230000
option privileged,uncallable;                                  <<06616>>04235000
begin                                                          <<06616>>04240000
                                                               <<06616>>04245000
logical                                                        <<06616>>04250000
   returnvalue = getsystabentry,                               <<06616>>04255000
   prev,                                                       <<06616>>04260000
   next,                                                       <<06616>>04265000
   entriesused,                                                <<06616>>04270000
   absolute'db,                                                <<06616>>04275000
   ucode'known'table,                                          <<06616>>04280000
   pcbpt,                                                      <<06616>>04285000
   num'free'entries,                                           <<06616>>04290000
   secondary'is'full,                                          <<06616>>04295000
   segment'was'absent,                                         <<06616>>04300000
   original'dst,                                               <<06616>>04305000
   entrysize;                                                  <<06616>>04310000
double                                                         <<06616>>04315000
   savedb;                                                     <<06616>>04320000
                                                               <<06616>>04325000
                                                               <<06616>>04330000
<< see if segment is present >>                                <<06616>>04335000
                                                               <<06616>>04340000
                                                               <<06620>>04345000
if not logical(dst(tabledst&lsl(2)+1)).segresidentflag         <<06620>>04350000
    then suddendeath(605);                                     <<06620>>04355000
disable;                                                       <<06616>>04360000
pcbpt := curprc;                                               <<06650>>04365000
segment'was'absent := logical(dst(tabledst&lsl(2))).absentflag;<<06616>>04370000
absolute'db := dbxdsinfo.absdbflag;                            <<06650>>04375000
<< put db at that segment >>                                   <<06616>>04380000
if segment'was'absent then                                     <<06616>>04385000
   begin                                                       <<06616>>04390000
   if curprc = 0 then                                          <<06650>>04395000
      suddendeath(900);                                        <<06616>>04400000
   if absolute'db then                                         <<06616>>04405000
      begin                                                    <<06616>>04410000
      push(db);                                                <<06616>>04415000
      savedb := tos;                                           <<06616>>04420000
      resetdb(-1);                                             <<06616>>04425000
      end;                                                     <<06616>>04430000
   original'dst := exchangedb(tabledst);                       <<06616>>04435000
   end                                                         <<06616>>04440000
else                                                           <<06616>>04445000
   begin                                                       <<06616>>04450000
   tos := dst(tabledst&lsl(2) + 2); << bank >>                 <<06616>>04455000
   tos := dst(x + 1); << address >>                            <<06616>>04460000
   asmb(xchd);                                                 <<06616>>04465000
   savedb := tos;                                              <<06616>>04470000
   end;                                                        <<06616>>04475000
again :                                                        <<07320>>04480000
                                                               <<06616>>04485000
   x := 0; << for addressing db direct indexed >>              <<06616>>04490000
   entrysize := systabentrysize;                               <<06616>>04495000
   ucode'known'table:=tabledst=dstdst lor tabledst=cstdst;     <<06616>>04500000
   secondary'is'full := if not ucode'known'table and           <<06616>>04505000
                          systabfreecnt <= systabprimarynum    <<06753>>04510000
                        then true else false;                  <<06753>>04515000
   num'free'entries := systabfreecnt - 1;                      <<06616>>04520000
   if < and (primary lor ucode'known'table) or                 <<07320>>04525000
      secondary'is'full and not primary and not wait then      <<06616>>04530000
      begin                                                    <<06616>>04535000
      getsystabentry := 0                                      <<06616>>04540000
      end                                                      <<06616>>04545000
   else                                                        <<06616>>04550000
      begin                                                    <<06616>>04555000
      if not ucode'known'table then                            <<06616>>04560000
         begin                                                 <<06616>>04565000
         if not primary then                                   <<06616>>04570000
            if secondary'is'full then                          <<06616>>04575000
               begin                                           <<06616>>04580000
               if systabimpheadinx = 0 then << first time >>   <<06616>>04585000
                  begin                                        <<06616>>04590000
                  pimppin := 0;                                <<06650>>04595000
                  nimppin := 0;                                <<06650>>04600000
                  x := 0;                                      <<06616>>04605000
                  systabimpheadinx := pcbpt;                   <<06616>>04610000
                  end                                          <<06616>>04615000
               else                                            <<06616>>04620000
                  begin                                        <<06616>>04625000
                  nimppin := 0;                                <<07320>>04630000
                  pimppin := systabimptail;                    <<*7564>>04635000
                  tos := pcbpt;                                <<*7564>>04640000
                  pcbpt := systabimptail;                      <<07320>>04645000
                  nimppin := s0;                               <<*7564>>04650000
                  pcbpt := tos;                                <<*7564>>04655000
                  end;                                         <<06616>>04660000
               x := 0;                                         <<06616>>04665000
               systabimptailinx := pcbpt;                      <<06616>>04670000
               systabimpcurrentnum := systabimpcurrentnum+1;   <<06616>>04675000
               systabimpcum := systabimpcum + 1;               <<06616>>04680000
               if systabimpcurrentnum > systabimpmax then      <<06616>>04685000
                  systabimpmax := systabimpcurrentnum;         <<06616>>04690000
               impede(0);                                      <<06616>>04695000
               if not segment'was'absent then                  <<06616>>04700000
                  begin << put db back, dsp put us at stack >> <<06616>>04705000
                  tos := dst(tabledst&lsl(2) + 2);             <<06616>>04710000
                  tos := dst(x + 1);                           <<06616>>04715000
                  asmb(xchd);                                  <<06616>>04720000
                  ddel;                                        <<06616>>04725000
                  x := 0;                                      <<06616>>04730000
                  end;                                         <<06616>>04735000
               go again;                                       <<07320>>04740000
               end;<<case of not having secondary entries>>    <<06616>>04745000
         end; << case of non special primary/secondary reqs >> <<06616>>04750000
      systabfreecnt := systabfreecnt - 1;                      <<06616>>04755000
      getsystabentry := x := systabfirstfreeinx;               <<06616>>04760000
      if x = 0 then suddendeath(605);                          <<s8699>>04765000
      next := systabentrynextfreeinx;                          <<06616>>04770000
      if next = 0 and num'free'entries > 0 then                <<s8699>>04775000
         suddendeath(605);                                     <<s8699>>04780000
      systabentry00(x) := 0;                                   <<06616>>04785000
      x := 0;                                                  <<06616>>04790000
      systabfirstfreeinx := next;                              <<06616>>04795000
      if not ucode'known'table then                            <<06616>>04800000
         begin                                                 <<06616>>04805000
         if next = 0 then                                      <<06616>>04810000
            systablastfreeinx := 0;                            <<06616>>04815000
         entriesused := systabentrycount - systabfreecnt;      <<06616>>04820000
         if entriesused > systabmostused then                  <<06616>>04825000
            systabmostused := entriesused;                     <<06616>>04830000
         end;                                                  <<06616>>04835000
      << zero out the entry >>                                 <<06616>>04840000
      tos := returnvalue + 1;                                  <<06616>>04845000
      tos := returnvalue;                                      <<06616>>04850000
      tos := entrysize - 1;                                    <<06616>>04855000
      asmb(move);                                              <<06616>>04860000
                                                               <<06616>>04865000
      end; << case of not having entries >>                    <<06616>>04870000
                                                               <<06616>>04875000
if segment'was'absent then                                     <<06616>>04880000
   begin                                                       <<06616>>04885000
   resetdb(original'dst);                                      <<06616>>04890000
   if absolute'db then                                         <<06616>>04895000
      begin                                                    <<06616>>04900000
      setsysdb;                                                <<06616>>04905000
      tos := savedb;                                           <<06616>>04910000
      asmb(xchd);                                              <<06616>>04915000
      ddel;                                                    <<06616>>04920000
      end;                                                     <<06616>>04925000
   end                                                         <<06616>>04930000
else                                                           <<06616>>04935000
   begin                                                       <<06616>>04940000
   tos := savedb;                                              <<06616>>04945000
   asmb(xchd);                                                 <<06616>>04950000
   end;                                                        <<06616>>04955000
                                                               <<06616>>04960000
end; << procedure getsystabentry >>                            <<06616>>04965000
$page                                                          <<06616>>04970000
integer procedure get'phy'cst;                                 <<06282>>04975000
   option uncallable;                                          <<06282>>04980000
                                                               <<06282>>04985000
begin                                                          <<06282>>04990000
                                                               <<06282>>04995000
   integer entryindex;                                         <<06282>>05000000
                                                               <<06282>>05005000
   disable;                                                    <<06282>>05010000
                                                               <<06282>>05015000
   if free'phy'cst'head = 0 then                               <<06282>>05020000
      begin                                                    <<06282>>05025000
         get'phy'cst := 0;  << no cst available >>             <<06282>>05030000
         return;                                               <<06282>>05035000
      end;                                                     <<06282>>05040000
                                                               <<06282>>05045000
   entryindex := free'phy'cst'head;                            <<06282>>05050000
   free'phy'cst'head := sl(entryindex+1);                      <<06282>>05055000
   sl(entryindex) := 0;    << zero out entry >>                <<06282>>05060000
   sl(x:=x+1) := 0;                                            <<06282>>05065000
   sl(x:=x+1) := 0;                                            <<06282>>05070000
   sl(x:=x+1) := 0;                                            <<06282>>05075000
   get'phy'cst := entryindex/cstsize;                          <<06282>>05080000
end;                                                           <<06282>>05085000
procedure rel'phy'cst (phycst);                                <<06282>>05090000
   value phycst;                                               <<06282>>05095000
   integer phycst;                                             <<06282>>05100000
   option uncallable;                                          <<06282>>05105000
                                                               <<06282>>05110000
begin                                                          <<06282>>05115000
                                                               <<06282>>05120000
   integer entryindex;                                         <<06282>>05125000
                                                               <<06282>>05130000
   disable;                                                    <<06282>>05135000
                                                               <<06282>>05140000
   entryindex := phycst*cstsize;                               <<06282>>05145000
   if phycst > total'phy'cst'num or                            <<06282>>05150000
      sl(entryindex) = %100000 then                            <<06282>>05155000
         suddendeath (603);                                    <<06282>>05160000
   sl(entryindex) := %100000;                                  <<06282>>05165000
   sl(entryindex+1) := free'phy'cst'head;                      <<06282>>05170000
   sl(entryindex+2) := 0;                                      <<06282>>05175000
   sl(entryindex+3) := 0;                                      <<06282>>05180000
   free'phy'cst'head := entryindex;                            <<06282>>05185000
end;                                                           <<06282>>05190000
$page                                                          <<06616>>05195000
procedure relsystabentry(tabledst,entryindex);                 <<06616>>05200000
value tabledst,entryindex;                                     <<06616>>05205000
logical tabledst,entryindex;                                   <<06616>>05210000
option privileged,uncallable;                                  <<*7862>>05215000
                                                               <<06616>>05220000
begin                                                          <<06616>>05225000
                                                               <<06616>>05230000
logical                                                        <<06616>>05235000
   pcbpt,                                                      <<06616>>05240000
   oldtail,                                                    <<06616>>05245000
   oldimphead,                                                 <<06616>>05250000
   absolute'db,                                                <<06616>>05255000
   segment'was'absent := false,                                <<06616>>05260000
   oldhead,                                                    <<06616>>05265000
   original'dst,                                               <<06616>>05270000
   entrysize;                                                  <<06616>>05275000
double                                                         <<06616>>05280000
   savedb;                                                     <<06616>>05285000
<< see if segment is present >>                                <<06616>>05290000
                                                               <<06616>>05295000
if entryindex = 0 then help;                                   <<06616>>05300000
if not logical(dst(tabledst&lsl(2)+1)).segresidentflag         <<06620>>05305000
    then suddendeath(605);                                     <<06620>>05310000
disable;                                                       <<06616>>05315000
pcbpt := curprc;                                               <<06650>>05320000
segment'was'absent := logical(dst(tabledst&lsl(2))).absentflag;<<06616>>05325000
absolute'db := dbxdsinfo.absdbflag;                            <<06650>>05330000
<< put db at that segment >>                                   <<06616>>05335000
if segment'was'absent then                                     <<06616>>05340000
   begin                                                       <<06616>>05345000
   if curprc = 0 then                                          <<06650>>05350000
      suddendeath(900);                                        <<06616>>05355000
   if absolute'db then                                         <<06616>>05360000
      begin                                                    <<06616>>05365000
      push(db);                                                <<06616>>05370000
      savedb := tos;                                           <<06616>>05375000
      resetdb(-1);                                             <<06616>>05380000
      end;                                                     <<06616>>05385000
   original'dst := exchangedb(tabledst);                       <<06616>>05390000
   end                                                         <<06616>>05395000
else                                                           <<06616>>05400000
   begin                                                       <<06616>>05405000
   tos := dst(tabledst&lsl(2) + 2); << bank >>                 <<06616>>05410000
   tos := dst(x + 1); << address >>                            <<06616>>05415000
   asmb(xchd);                                                 <<06616>>05420000
   savedb := tos;                                              <<06616>>05425000
   end;                                                        <<06616>>05430000
                                                               <<06616>>05435000
x := 0;                                                        <<06616>>05440000
entrysize := systabentrysize;                                  <<06616>>05445000
if entryindex <= 0 or                                          <<06616>>05450000
   (entryindex > (entrysize*systabconfcount(x))) then          <<06616>>05455000
   suddendeath(603);                                           <<06616>>05460000
systabfreecnt := systabfreecnt + 1;                            <<06616>>05465000
if tabledst = dstdst or tabledst = cstdst then                 <<06616>>05470000
   begin                                                       <<06616>>05475000
   oldhead := systabfirstfreeinx;                              <<06616>>05480000
   if oldhead = 0 and systabfreecount > 1 then                 <<s8699>>05485000
      suddendeath(605);                                        <<s8699>>05490000
   systabfirstfreeinx := entryindex;                           <<06616>>05495000
   x := entryindex;                                            <<06616>>05500000
   systabentrynextfreeinx := oldhead;                          <<06616>>05505000
   systabfreeindicator := %100000;                             <<06616>>05510000
   end                                                         <<06616>>05515000
else                                                           <<06616>>05520000
   begin                                                       <<06616>>05525000
   x := 0;                                                     <<*7564>>05530000
   oldtail := systablastfreeinx;                               <<06616>>05535000
   systablastfreeinx := entryindex;                            <<06616>>05540000
   if oldtail = 0 then                                         <<06616>>05545000
      begin << table was empty >>                              <<06616>>05550000
      systabfirstfreeinx := entryindex;                        <<06616>>05555000
      x := entryindex;                                         <<06616>>05560000
      systabentrynextfreeinx := 0;                             <<06616>>05565000
      end                                                      <<06616>>05570000
   else                                                        <<06616>>05575000
      begin                                                    <<06616>>05580000
      x := oldtail;                                            <<06616>>05585000
      systabentrynextfreeinx := entryindex;                    <<06616>>05590000
      x := entryindex;                                         <<06616>>05595000
      systabentrynextfreeinx := 0;                             <<06616>>05600000
      end;                                                     <<06616>>05605000
   x := 0;                                                     <<06616>>05610000
   if systabfreecnt > systabprimarynum then                    <<06616>>05615000
      begin << see if any impeded >>                           <<06616>>05620000
      if systabimphead  <> 0 then                              <<06616>>05625000
         begin << unimpede sucker >>                           <<06616>>05630000
         if systabimphead = systabimptail then                 <<06616>>05635000
            begin << the only guy >>                           <<06616>>05640000
            oldimphead := systabimphead;                       <<06616>>05645000
            systabimphead := 0;                                <<06616>>05650000
            systabimptail := 0;                                <<06616>>05655000
            end                                                <<06616>>05660000
         else                                                  <<06616>>05665000
            begin << got a long q >>                           <<06616>>05670000
            oldimphead := systabimphead;                       <<06616>>05675000
            pcbpt := pcb(oldimphead + nimppinwordnum);         <<06650>>05680000
            pcb(oldimphead + nimppinwordnum) := 0;             <<06650>>05685000
            pimppin := 0;                                      <<06650>>05690000
            x := 0;                                            <<06616>>05695000
            systabimphead := pcbpt;                            <<06616>>05700000
            end;                                               <<06616>>05705000
         systabimpcurrentnum := systabimpcurrentnum - 1;       <<07320>>05710000
         unimpede(oldimphead);                                 <<06616>>05715000
         end;                                                  <<06616>>05720000
      end;                                                     <<06616>>05725000
   end;                                                        <<06616>>05730000
if segment'was'absent then                                     <<06616>>05735000
   begin                                                       <<06616>>05740000
   resetdb(original'dst);                                      <<06616>>05745000
   if absolute'db then                                         <<06616>>05750000
      begin                                                    <<06616>>05755000
      setsysdb;                                                <<06616>>05760000
      tos := savedb;                                           <<06616>>05765000
      asmb(xchd);                                              <<06616>>05770000
      ddel;                                                    <<06616>>05775000
      end;                                                     <<06616>>05780000
   end                                                         <<06616>>05785000
else                                                           <<06616>>05790000
   begin                                                       <<06616>>05795000
   tos := savedb;                                              <<06616>>05800000
   asmb(xchd);                                                 <<06616>>05805000
   end;                                                        <<06616>>05810000
end; << procedure relsystabentry >>                            <<06616>>05815000
$page "MESSAGE FACILITY INTRINSICS : SEND MESSAGE"             <<06212>>05820000
$page "MEASUREMENT INTERFACE : UPDATESTATISTICS"                        05825000
integer procedure updatestatistics(class,subclass,subclassentry,        05830000
                                   startingitem,newvalueflag,           05835000
                                   valuechange,doubleitemflag);         05840000
  value   class,subclass,subclassentry,startingitem,newvalueflag,       05845000
          valuechange,doubleitemflag;                                   05850000
  integer class,subclass,subclassentry,startingitem;                    05855000
  double  valuechange;                                                  05860000
  logical newvalueflag,doubleitemflag;                                  05865000
  option  privileged,uncallable;                                        05870000
                                                                        05875000
comment                                                                 05880000
*************************************************************           05885000
this procedure is used to update an item in a given class,              05890000
subclass, entry defined by the mpe iv measurement interface.            05895000
                                                                        05900000
input parameters:                                                       05905000
                                                                        05910000
      class,          the classnumber of stats to be updated            05915000
      subclass,       subclass number of class                          05920000
      subclassenty,   entry number of subclass                          05925000
      startingitem,           startingitem # of entry                   05930000
      newvalueflag,   if true=> valuechange parm replaces startingitem  05935000
                      else add valuechange to old startingitem          05940000
      valuechange     either added to or replaces old startingitem      05945000
      doubleitemflag  if true=> valuechange is a double word update     05950000
                                                                        05955000
return values:                                                          05960000
                                                                        05965000
      cc = ccl ==> bad parameter                                        05970000
      cc = cce ==> ok                                                   05975000
      cc = ccg ==> not used                                             05980000
                                                                        05985000
      updatestatistics = 0 ==> ok                                       05990000
                       = 1 ==> stats not enabled                        05995000
                       = 2 ==> bad startingitem parm                    06000000
                       = 3 ==> bad subclassentry parm                   06005000
                       = 4 ==> bad subclass parm                        06010000
                       = 5 ==> bad class parm                           06015000
                                                                        06020000
entry points:                                                           06025000
                                                                        06030000
      fupdatestatistics: will bypass all parameter checking,            06035000
                         but will not allow updating if class           06040000
                         not enabled.                                   06045000
                                                                        06050000
operation:                                                              06055000
                                                                        06060000
      updatestatistics will first check to see that the class           06065000
      of statistics requested to be updated has been enabled.           06070000
      if it was enabled it will use abs addressing to retrieve          06075000
      some offsets and values from the locked and frozen stat-          06080000
      istics gathering datasegment. if the alternate entry point        06085000
      fupdatestatistics was not used, then parameter checking is        06090000
      preformed on the class, subclass, subclassentry and start-        06095000
      ingitem parameters. if an error was encountered then cc           06100000
      is set to ccl and we return, otherwise either a single            06105000
      or double item is updated (based on doubleitemflag) and           06110000
      the oldvalue is either incremented or replaced (based on          06115000
      newvalueflag).                                                    06120000
                                                                        06125000
*************************************************************           06130000
;                                                                       06135000
begin                                                                   06140000
                                                                        06145000
equate  notenbld       = 1,  <<statistics gath not enbld>>              06150000
        item'error     = 2,  <<item out of range     >>                 06155000
        subentry'error = 3,  <<subclass out of range >>                 06160000
        subclass'error = 4,  <<subclass out of range    >>              06165000
        class'error    = 5;  <<class out of range   >>                  06170000
                                                                        06175000
integer error:=notenbld,                                                06180000
        classbase,       <<offset to requested class>>                  06185000
        subbase,         <<seg rel offset to req subclass>>             06190000
        actual'entries,  <<num entries less entry 0>>                   06195000
        valuechange0=valuechange,  <<msw of valuechange>>               06200000
        valuechange1=valuechange+1,<<lsw of valuechange>>               06205000
        savecc,          <<temp cond code>>                             06210000
        x=x,             <<x reg>>                                      06215000
        status=q-1;      <<status register>>                            06220000
                                                                        06225000
integer array c0'subsizes(*) = pb:= class0'sub0size,                    06230000
                                    class0'sub1size,                    06235000
                                    class0'sub2size,                    06240000
                                    class0'sub3size;                    06245000
                                                                        06250000
integer array c1'subsizes(*) = pb:= class1'sub0size,                    06255000
                                    class1'sub1size,                    06260000
                                    class1'sub2size,                    06265000
                                    class1'sub3size,                    06270000
                                    class1'sub4size,                    06275000
                                    class1'sub5size;                    06280000
                                                                        06285000
logical pointer measinfo'tabptr = %261;                                 06290000
                                                                        06295000
logical fupdate:=false;                                                 06300000
                                                                        06305000
entry fupdatestatistics;        <<will bypass parm checking>>           06310000
                                                                        06315000
define classbase'idx   = (class+1)#,  <<offset to class>>               06320000
       subbase'idx     = (subclass+1)#, <<offset to subclass>>          06325000
       act'startingitem= (startingitem+3)#; <<get past entry 0>>        06330000
                                                                        06335000
<<***************subroutines*********************>>                     06340000
                                                                        06345000
logical subroutine goodsubclass;                                        06350000
begin  <<check for valid subclass>>                                     06355000
goodsubclass:=true;                                                     06360000
case class of                                                           06365000
   begin                                                                06370000
   <<class0>>                                                           06375000
   if subclass < 0 or subclass >= class0'subclasscnt then               06380000
      goodsubclass:=false;                                              06385000
   <<class1>>                                                           06390000
   if subclass < 0 or subclass >= class1'subclasscnt then               06395000
      goodsubclass:=false;                                              06400000
   end; <<case>>                                                        06405000
end; <<goodsubclass>>                                                   06410000
                                                                        06415000
                                                                        06420000
logical subroutine goodentry;                                           06425000
begin <<check for valid subclassentry>>                                 06430000
goodentry:=true;                                                        06435000
if subclassentry < 1 or    <<do not allow updating>>                    06440000
subclassentry > actual'entries then  <<of entry 0>>                     06445000
   goodentry:=false;                                                    06450000
end; <<goodentry>>                                                      06455000
                                                                        06460000
                                                                        06465000
logical subroutine goodstartitem;                                       06470000
begin <<check for good startingitem>>                                   06475000
goodstartitem:=true;                                                    06480000
case class of                                                           06485000
   begin                                                                06490000
   <<class0>>                                                           06495000
   if startingitem < 0 or                                               06500000
   startingitem >= c0'subsizes(subclass) or                             06505000
   doubleitemflag and startingitem+1 >= c0'subsizes(subclass) then      06510000
      goodstartitem:=false;                                             06515000
   <<class1>>                                                           06520000
   if startingitem < 0 or                                               06525000
   startingitem >= c1'subsizes(subclass) or                             06530000
   doubleitemflag and startingitem+1 >= c1'subsizes(subclass) then      06535000
      goodstartitem:=false;                                             06540000
   end; <<case>>                                                        06545000
end; <<goodstartitem>>                                                  06550000
                                                                        06555000
                                                                        06560000
logical subroutine goodclass;                                           06565000
begin << check for valid class>>                                        06570000
goodclass:=true;                                                        06575000
if class < 0 or class >= classcount then                                06580000
   goodclass:=false;                                                    06585000
end; <<goodclass>>                                                      06590000
                                                                        06595000
<<******************end of subroutines******************>>              06600000
                                                                        06605000
goto start;                                                             06610000
                                                                        06615000
fupdatestatistics:                                                      06620000
                                                                        06625000
fupdate:=true;                                                          06630000
                                                                        06635000
start:                                                                  06640000
                                                                        06645000
pdisable;   <<make sure no one changes gathering status>>               06650000
                                                                        06655000
tos:=gclassenabledmask;   <<check to see if requested class>>           06660000
x:=class;                 <<is currently enabled>>                      06665000
asmb(tbc 0,x);                                                          06670000
if <> then                                                              06675000
   begin                   <<class was enabled>>                        06680000
                                                                        06685000
   error:=0;                                                            06690000
                                                                        06695000
   tos:=measstatxdsbank;                                                06700000
   tos:=measstatxdsbase+ldevtabsize;  <<get beyond ldevtab>>            06705000
   tos:=tos+classbase'idx;            <<abs addr of classbase ptr>>     06710000
   asmb(lsea);                        <<pull out offset to class >>     06715000
   classbase:=tos;                                                      06720000
                                                                        06725000
   <<now get segreloff for subclass>>                                   06730000
                                                                        06735000
   tos:=classbase-classbase'idx+subbase'idx; <<add segrel offsets>>     06740000
   asmb(ladd;lsea);       <<add to abs addr of classbase ptr>>          06745000
   subbase:=tos+classbase;<<segrel offset to base of subclass>>         06750000
                                                                        06755000
   <<finally pull out number of entries in subclass>>                   06760000
                                                                        06765000
   tos:=subbase-classbase-subbase'idx;                                  06770000
   asmb(ladd);                                                          06775000
   asmb(lsea);                                                          06780000
   actual'entries:=tos-1;   <<sub 1 for entry 0>>                       06785000
   ddel;                                                                06790000
                                                                        06795000
   if not fupdate then                                                  06800000
      begin               <<parameter checking>>                        06805000
                                                                        06810000
      if not goodclass then                                             06815000
         error := class'error                                           06820000
      else                                                              06825000
         if not goodsubclass then                                       06830000
            error:=subclass'error                                       06835000
         else                                                           06840000
            if not goodentry then                                       06845000
               error:=subentry'error                                    06850000
            else                                                        06855000
               if not goodstartitem then                                06860000
                  error := item'error                                   06865000
      end;                                                              06870000
                                                                        06875000
   end; <<class enabled>>                                               06880000
                                                                        06885000
if error = 0 then                                                       06890000
                                                                        06895000
   begin <<update item>>                                                06900000
   tos := measstatxdsbank;                                              06905000
   tos := measstatxdsbase+ldevtabsize+subbase+act'startingitem;         06910000
   if not doubleitemflag then                                           06915000
                                                                        06920000
      begin <<process single item update>>                              06925000
      if not newvalueflag then                                          06930000
         begin <<retrive old value, add w/vlauechange,store>>           06935000
         asmb(lsea);                                                    06940000
         tos:=tos+valuechange1;                                         06945000
         asmb(ssea);                                                    06950000
         end                                                            06955000
      else                                                              06960000
         begin <<replace oldvalue w/valuechange>>                       06965000
         tos:=valuechange1;                                             06970000
         asmb(ssea);                                                    06975000
         end;                                                           06980000
      end   <<single item update>>                                      06985000
                                                                        06990000
   else                                                                 06995000
                                                                        07000000
      begin <<process double item update>>                              07005000
      if not newvalueflag then                                          07010000
         begin <<retrieve old value, add w/valuechange,store>>          07015000
         asmb(ldea);                                                    07020000
         tos:=tos+valuechange;                                          07025000
         asmb(sdea);                                                    07030000
         end                                                            07035000
      else                                                              07040000
         begin <<replace old value w/valuechange>>                      07045000
         tos:=valuechange;                                              07050000
         asmb(sdea);                                                    07055000
         end;                                                           07060000
      end;                                                              07065000
                                                                        07070000
   ddel; <<bank,address>>                                               07075000
   savecc:=cce;                                                         07080000
   end                                                                  07085000
                                                                        07090000
else                                                                    07095000
                                                                        07100000
   savecc:=ccl;                                                         07105000
                                                                        07110000
penable;                                                                07115000
updatestatistics:=error;                                                07120000
cc:=savecc;                                                             07125000
end;  <<updatestatistics>>                                              07130000
procedure meas'objfault(obj);                                   <<meas>>07135000
value obj;                                                      <<meas>>07140000
double obj;                                                     <<meas>>07145000
option privileged , uncallable;                                 <<meas>>07150000
begin                                                           <<meas>>07155000
logical array objid(*) = obj;                                   <<meas>>07160000
integer stop'index;                                             <<meas>>07165000
if gclassenabledmask.class0 then begin                          <<meas>>07170000
  case objid(objidtypefield) of begin                           <<meas>>07175000
    <<0>>  stop'index := c'stopdatafault;                       <<meas>>07180000
    <<1>>  stop'index := c'stopslfault;                         <<meas>>07185000
    <<2>>  stop'index := c'stoppbxfault;                        <<meas>>07190000
    <<3>>  stop'index := c'stopcachefault;                      <<meas>>07195000
  end; <<case>>                                                 <<meas>>07200000
  tos := measstatxdsbank;                                       <<meas>>07205000
  tos := measstatxdsbase;                                       <<meas>>07210000
  tos := tos + c0sub0'segreloff + stop'index;                   <<meas>>07215000
  asmb(lsea);                                                   <<meas>>07220000
  tos := tos + 1;                                               <<meas>>07225000
  asmb(ssea;ddel);                                              <<meas>>07230000
end; <<class 0 enabled>>                                        <<meas>>07235000
if gclassenabledmask.class15 then begin <<class 15 enabled>>    <<meas>>07240000
  case objid(objidtypefield) of begin                           <<meas>>07245000
    <<0>>  stop'index := cp'stopdstfault;                       <<meas>>07250000
    <<1>>  stop'index := cp'stopslfault;                        <<meas>>07255000
    <<2>>  stop'index := cp'stoppbxfault;                       <<meas>>07260000
    <<3>>  stop'index := cp'stopdstfault; <<cp'stopcachefault>> <<meas>>07265000
  end;  <<case>>                                                <<meas>>07270000
  tos := measprocxdsbank;                                       <<meas>>07275000
  tos := measprocxdsbase;                                       <<meas>>07280000
  tos := tos + curprc/pcbsize * class15'sub0size + stop'index;  <<meas>>07285000
  asmb(lsea);                                                   <<meas>>07290000
  tos := tos + 1;                                               <<meas>>07295000
  asmb(ssea;ddel);                                              <<meas>>07300000
end;                                                            <<meas>>07305000
end; <<procedure meas'objfault>>                                <<meas>>07310000
$page "UNCALLABLE UTILITIES : SYSPROC"                                  07315000
procedure readyprocess(pcbpt);                                 <<03041>>07320000
value pcbpt;                                                   <<03041>>07325000
integer pcbpt;                                                 <<03041>>07330000
option privileged,uncallable;                                  <<03041>>07335000
begin                                                          <<03041>>07340000
logical                                                        <<03041>>07345000
   pawsedflag;                                                 <<03041>>07350000
                                                               <<03041>>07355000
if not log(spcbdispq) and spcbwaitfield = 0 then               <<03041>>07360000
   begin <<must get process into contention for the cpu>>      <<03041>>07365000
   pdisable;  <<pseudo disable for fast db switch>>            <<03041>>07370000
   tos:=%1000d;                                                <<03041>>07375000
   exchdb;                                                     <<03041>>07380000
   queueproc(pcbpt,dispatchingq,frontofclass);                 <<06650>>07385000
   pawsedflag:=disptoawakemsg.pausedflag;                      <<03041>>07390000
   exchdb;                                                     <<03041>>07395000
   penable;                                                    <<03041>>07400000
   if pawsedflag then asmb(disp);                              <<03041>>07405000
   end;                                                        <<03041>>07410000
end;  <<readyprocess>>                                         <<03041>>07415000
logical procedure sysproc(logicalprocnumber);                           07420000
value logicalprocnumber;                                                07425000
integer logicalprocnumber;                                              07430000
option privileged,uncallable;                                           07435000
                                                                        07440000
comment                                                                 07445000
                                                                        07450000
sysproc converts the caller supplied logical process                    07455000
number into the pcb relative pointer to that process'                   07460000
pcb entry.                                                              07465000
                                                                        07470000
;                                                                       07475000
                                                                        07480000
begin                                                                   07485000
                                                               <<06212>>07490000
equate logproctabbase=%1141,                                            07495000
       logproctabsize=12;                                               07500000
                                                                        07505000
sysproc:=if logicalprocnumber > logproctabsize then 0                   07510000
else absolute(logproctabbase+logicalprocnumber);                        07515000
end  <<procedure sysproc>>;                                             07520000
$page "UNCALLABLE UTILITIES : BUILD/CONVERT SEG ID"                     07525000
double  procedure buildobjid(objtype,objnumber,pin);           <<06660>>07530000
value objtype,objnumber,pin;                                   <<06212>>07535000
integer objtype,objnumber,pin;                                 <<06212>>07540000
option privileged,uncallable;                                           07545000
                                                                        07550000
comment                                                                 07555000
                                                                        07560000
buildobjid converts the object number parameter into the stand <<06212>>07565000
invariant form of objidentifier used throughout the system.    <<06212>>07570000
this routine may be called in split stack mode.                <<06212>>07575000
                                                                        07580000
objtype =dataobject ==> object is a data object,               <<06212>>07585000
               objnumber=dst entry number of object's descripto<<06212>>07590000
        =slobject ==> object is a system sl object,            <<06212>>07595000
               objnumber=sl entry number of object's descriptor<<06212>>07600000
        =pbxobject ==> object is a part of a program,          <<06212>>07605000
               objnumber=program object number (>%300),        <<06212>>07610000
               pin=pin of process executing the program                 07615000
        =mappeddomainobject ==> object is a cached disc domain,<<06212>>07620000
               objnumber = cdt entry of mapped disc domain     <<06212>>07625000
                                                                        07630000
;                                                              <<06212>>07635000
                                                               <<06212>>07640000
begin                                                                   07645000
                                                               <<06212>>07650000
double  objid;                                                 <<06660>>07655000
double  segid=objid;                                           <<06660>>07660000
integer segnumber=objnumber;                                   <<06212>>07665000
double  built := 0d;                                           <<06660>>07670000
logical array buildspace(*)=built;                             <<06660>>07675000
define segidpbxfield=objidpbxfield#;                           <<06212>>07680000
                                                               <<06212>>07685000
entry buildsegid; <<for backwards compatibility>>              <<06212>>07690000
                                                               <<06212>>07695000
buildsegid :                                                   <<06212>>07700000
                                                               <<06212>>07705000
if objtype=dataobject then begin << data object >>             <<06660>>07710000
   buildspace(objidtypefield):=dataobject;                     <<06660>>07715000
   buildspace(objidnumfield):=objnumber;                       <<06660>>07720000
end else if objtype = mappeddomainobject then                  <<06660>>07725000
   begin  <<mapped disc domain>>                               <<06212>>07730000
   buildspace(objidtypefield):= mappeddomainobject;            <<06660>>07735000
   buildspace(objidnumfield):=objnumber;                       <<06660>>07740000
   end                                                         <<06212>>07745000
else                                                           <<06212>>07750000
   begin  <<code obj >>                                        <<06212>>07755000
   if objtype=slobject then                                    <<06660>>07760000
      begin <<sl obj>>                                         <<06212>>07765000
      buildspace(objidtypefield):=slobject;                    <<06660>>07770000
      buildspace(objidnumfield):=objnumber;                    <<06660>>07775000
      end                                                               07780000
   else                                                                 07785000
      begin <<program object>>                                 <<06212>>07790000
      if objtype <> pbxobject then suddendeath(619);           <<06212>>07795000
      if mappingfirmware then                                  <<06104>>07800000
         tos:=segnumber                                        <<06104>>07805000
      else                                                     <<06104>>07810000
      tos:=objnumber-%300;                                     <<06212>>07815000
      buildspace(objidnumfield):=tos;                          <<06660>>07820000
      buildspace(objidtypefield):=pbxobject;                   <<06660>>07825000
      buildspace(objidpbxfield):=                              <<06660>>07830000
            pcb(pin * pcbsize + pbxwordnum);                   <<06650>>07835000
      end;                                                              07840000
   end;                                                                 07845000
   buildobjid:=built;                                          <<06660>>07850000
end <<buildobjid>>;                                            <<06212>>07855000
logical procedure label'is'sl'seg (plabel,pcbpt);              <<06104>>07860000
value plabel,pcbpt;                                            <<06104>>07865000
integer plabel,pcbpt;                                          <<06104>>07870000
option uncallable;                                             <<06282>>07875000
                                                               <<06104>>07880000
<<return true if plabel is a sl segment   >>                   <<06104>>07885000
<<       false if it is a program segment >>                   <<06104>>07890000
                                                               <<06104>>07895000
begin                                                          <<06104>>07900000
                                                               <<06104>>07905000
   define phymapping    = logical(plabel.(0:1))#,              <<06104>>07910000
          segnumber     = plabel.(8:8)#,                       <<06104>>07915000
          progsegnum    = dst(cstxblk(spcbpbx))#;              <<06104>>07920000
   pdisable;                                                   <<06104>>07925000
   if pcbpt = 0 then pcbpt := (curprc);                        <<06650>>07930000
   if mappingfirmware then                                     <<06104>>07935000
      if phymapping then                                       <<06104>>07940000
         label'is'sl'seg := true                               <<06104>>07945000
      else                                                     <<06104>>07950000
         if segnumber > progsegnum then                        <<06104>>07955000
            label'is'sl'seg :=true                             <<06104>>07960000
         else                                                  <<06104>>07965000
            label'is'sl'seg :=false                            <<06104>>07970000
   else                                                        <<06104>>07975000
      if segnumber < %300 then                                 <<06104>>07980000
         label'is'sl'seg := true                               <<06104>>07985000
      else                                                     <<06104>>07990000
         label'is'sl'seg := false;                             <<06104>>07995000
   penable;                                                    <<06104>>08000000
end;                                                           <<06104>>08005000
                                                               <<06104>>08010000
logical procedure marker'is'sl'seg(status',deltap,pcbpt);      <<07365>>08015000
value status',deltap,pcbpt;                                    <<07365>>08020000
integer status',deltap,pcbpt;                                  <<07365>>08025000
option uncallable;                                             <<06282>>08030000
<<return true if marker is a sl segment   >>                   <<06104>>08035000
<<       false if it is a program segment >>                   <<06104>>08040000
                                                               <<06104>>08045000
begin                                                          <<06104>>08050000
                                                               <<06104>>08055000
define phymapping    = logical(deltap.(1:1))#,                 <<07365>>08060000
       segnumber     = status'.(8:8)#,                         <<07365>>08065000
          progsegnum    = dst(cstxblk(spcbpbx))#;              <<06104>>08070000
   pdisable;                                                   <<06104>>08075000
   if pcbpt = 0 then pcbpt := (curprc);                        <<06650>>08080000
   if mappingfirmware then                                     <<06104>>08085000
      if phymapping then                                       <<06104>>08090000
         marker'is'sl'seg := true                              <<06104>>08095000
      else                                                     <<06104>>08100000
         if segnumber > progsegnum then                        <<06104>>08105000
            marker'is'sl'seg :=true                            <<06104>>08110000
         else                                                  <<06104>>08115000
            marker'is'sl'seg :=false                           <<06104>>08120000
   else                                                        <<06104>>08125000
      if segnumber < %300 then                                 <<06104>>08130000
         marker'is'sl'seg := true                              <<06104>>08135000
      else                                                     <<06104>>08140000
         marker'is'sl'seg := false;                            <<06104>>08145000
   penable;                                                    <<06104>>08150000
end;                                                           <<06104>>08155000
                                                                        08160000
integer procedure convsegidtostinx(objtemporary);              <<06660>>08165000
value objtemporary ;                                           <<06660>>08170000
double  objtemporary ;                                         <<06660>>08175000
option privileged,uncallable;                                           08180000
                                                                        08185000
comment                                                                 08190000
                                                                        08195000
converts a objidentifier to the current segment table index of <<06212>>08200000
the corresponding segment's descriptor. this routine may       <<01609>>08205000
be called in split stack mode.                                 <<01609>>08210000
                                                               <<06212>>08215000
this routine works only for objects which are segments.        <<06212>>08220000
doesn't work for mapped disc domain objects.                   <<06212>>08225000
                                                               <<06212>>08230000
if the designated segment descriptor is valid, the condition   <<06660>>08235000
code is set to cce and the segment table relative index of the <<06660>>08240000
segment descriptor is returned.                                <<06212>>08245000
                                                               <<01557>>08250000
if the designated descriptor is unassigned, the condition code <<01557>>08255000
set to ccl and a zero is returned.                             <<01557>>08260000
                                                               <<01557>>08265000
                                                                        08270000
;                                                                       08275000
                                                                        08280000
begin                                                                   08285000
logical array objidentifier(*)=objtemporary;                   <<06660>>08290000
integer descstinx=convsegidtostinx,                            <<06212>>08295000
        condcode:=cce;                                         <<01557>>08300000
                                                               <<06212>>08305000
if objidentifier(objidtypefield)= objidcdtype                  <<06660>>08310000
then suddendeath(sfkerncacheintbad);                           <<06212>>08315000
                                                               <<06212>>08320000
if objidentifier(objidtypefield)=objiddatatype                 <<06660>>08325000
then convsegidtostinx:=objidentifier(objidnumfield)&lsl(2) else<<06660>>08330000
   begin  <<code obj>>                                         <<06212>>08335000
   if objidentifier(objidtypefield)=objidpgmtype then          <<06660>>08340000
      begin <<in a program block>>                                      08345000
      x:=objidentifier(objidpbxfield);                         <<06660>>08350000
      if cstxblk(x)=-1 then                                    <<01913>>08355000
         begin                                                 <<01913>>08360000
         condcode:=ccl;                                        <<01913>>08365000
         convsegidtostinx:=0;                                  <<06212>>08370000
         end                                                   <<01913>>08375000
      else                                                     <<01913>>08380000
      convsegidtostinx := cstxblk(x) +                         <<06660>>08385000
         integer(objidentifier(objidnumfield) & lsl(2));       <<06660>>08390000
      end                                                               08395000
   else                                                                 08400000
      begin <<sl obj>>                                         <<06212>>08405000
      convsegidtostinx := objidentifier(objidnumfield) & lsl(2)<<06660>>08410000
                            + absolute(sysdfc);                <<06660>>08415000
      end;                                                              08420000
   end;                                                                 08425000
if dst(descstinx)=%100000 then                                 <<01557>>08430000
   begin  <<unallocated entry>>                                <<01557>>08435000
   condcode:=ccl;                                              <<01557>>08440000
   descstinx:=0;                                               <<01557>>08445000
   end;                                                        <<01557>>08450000
cc:=condcode;                                                  <<01557>>08455000
end  <<convsegidtostinx>>;                                     <<06212>>08460000
                                                                        08465000
$page "Uncallable Utilities : Is Object Present ? "            <<06212>>08470000
                                                               <<06212>>08475000
logical procedure isobjectabsent ( obj );                      <<06660>>08480000
value obj;                                                     <<06660>>08485000
double  obj;                                                   <<06660>>08490000
option privileged,uncallable;                                  <<06212>>08495000
                                                               <<06212>>08500000
comment                                                        <<06212>>08505000
                                                               <<06212>>08510000
returns true if object is marked absent  else returns false.   <<06212>>08515000
                                                               <<06212>>08520000
;                                                              <<06212>>08525000
                                                               <<06212>>08530000
begin                                                          <<06212>>08535000
logical array objid(*) = obj;                                  <<06660>>08540000
integer stinx;                                                 <<*7564>>08545000
                                                               <<*7564>>08550000
if objid(objidtypefield) = objidcdtype then                    <<d7738>>08555000
   begin                                                       <<d7738>>08560000
   cdt'abs'on'tos;                                             <<d7738>>08565000
   tos := tos + objid(objidnumfield) * cdt'entry'size;         <<d7738>>08570000
   tos := tos + cdt'md'flags;                                  <<d7738>>08575000
   asmb(lsea;delb,delb);                                       <<d7738>>08580000
   isobjectabsent := tos.cdt'absent;                           <<d7738>>08585000
   end                                                         <<d7738>>08590000
else                                                           <<*7564>>08595000
   begin                                                       <<*7564>>08600000
   stinx := convsegidtostinx(obj);                             <<*7564>>08605000
   if < then suddendeath(617);                                 <<*7564>>08610000
   isobjectabsent := dst(stinx).absentflag;                    <<*7564>>08615000
   end;                                                        <<*7564>>08620000
                                                               <<06212>>08625000
end;  <<isobjectabsent>>                                       <<06212>>08630000
$page "Uncallable Utilities : Process Pri"                     <<06212>>08635000
                                                               <<06212>>08640000
integer procedure processpri(pin);                             <<06212>>08645000
value pin;                                                     <<06212>>08650000
integer pin;                                                   <<06212>>08655000
option privileged,uncallable;                                  <<06212>>08660000
                                                               <<06212>>08665000
begin                                                          <<06212>>08670000
if pin=0 then suddendeath(sfkernbadparm);                      <<06212>>08675000
processpri := pcb(pin*pcbsize+queueinginfowordnum).prifield;   <<06212>>08680000
end;  <<processpri>>                                           <<06212>>08685000
                                                               <<06212>>08690000
$page "Uncallable Utilities : Is Object a ROC  ? "             <<06212>>08695000
                                                               <<06212>>08700000
logical procedure isobjectroc ( obj );                         <<06660>>08705000
value obj;                                                     <<06660>>08710000
double  obj;                                                   <<06660>>08715000
option privileged,uncallable;                                  <<06212>>08720000
                                                               <<06212>>08725000
comment                                                        <<06212>>08730000
                                                               <<06212>>08735000
returns true if object is marked an roc else returns false.    <<06212>>08740000
                                                               <<06212>>08745000
;                                                              <<06212>>08750000
                                                               <<06212>>08755000
begin                                                          <<06212>>08760000
logical array objid(*)=obj;                                    <<06660>>08765000
integer stinx;                                                 <<*7564>>08770000
                                                               <<*7564>>08775000
if objid(objidtypefield) = objidcdtype then                    <<d7738>>08780000
   begin                                                       <<d7738>>08785000
   cdt'abs'on'tos;                                             <<d7738>>08790000
   tos := tos + objid(objidnumfield) * cdt'entry'size;         <<d7738>>08795000
   tos := tos + cdt'md'flags;                                  <<d7738>>08800000
   asmb(lsea;delb,delb);                                       <<d7738>>08805000
   isobjectroc := tos.cdt'roc;                                 <<d7738>>08810000
   end                                                         <<d7738>>08815000
else                                                           <<*7564>>08820000
   begin                                                       <<*7564>>08825000
   stinx := convsegidtostinx(obj);                             <<*7564>>08830000
   if < then suddendeath(617);                                 <<*7564>>08835000
   isobjectroc := dst(stinx).rocflag;                          <<*7564>>08840000
   end;                                                        <<*7564>>08845000
                                                               <<06212>>08850000
end;  <<isobjectroc>>                                          <<06212>>08855000
                                                               <<06212>>08860000
$page "Uncallable Utilities : Is Object In Motion In ? "       <<06411>>08865000
                                                               <<06411>>08870000
logical procedure isobjectimi ( obj );                         <<06660>>08875000
value obj;                                                     <<06660>>08880000
double obj;                                                    <<06660>>08885000
option privileged,uncallable;                                  <<06411>>08890000
                                                               <<06411>>08895000
comment                                                        <<06411>>08900000
                                                               <<06411>>08905000
returns true if object is marked imi     else returns false.   <<06411>>08910000
                                                               <<06411>>08915000
;                                                              <<06411>>08920000
                                                               <<06411>>08925000
begin                                                          <<06411>>08930000
logical array objid(*)=obj;                                    <<06660>>08935000
integer stinx;                                                 <<*7564>>08940000
                                                               <<*7564>>08945000
if objid(objidtypefield) = objidcdtype then                    <<d7738>>08950000
   begin                                                       <<d7738>>08955000
   cdt'abs'on'tos;                                             <<d7738>>08960000
   tos := tos + objid(objidnumfield) * cdt'entry'size;         <<d7738>>08965000
   tos := tos + cdt'md'flags;                                  <<d7738>>08970000
   asmb(lsea;delb,delb);                                       <<d7738>>08975000
   isobjectimi := tos.cdt'imi;                                 <<d7738>>08980000
   end                                                         <<d7738>>08985000
else                                                           <<*7564>>08990000
   begin                                                       <<*7564>>08995000
   stinx := convsegidtostinx(obj);                             <<*7564>>09000000
   if < then suddendeath(617);                                 <<*7564>>09005000
   isobjectimi := dst(stinx).imiflag;                          <<*7564>>09010000
   end;                                                        <<*7564>>09015000
                                                               <<*7564>>09020000
end;      <<isobjectimi>>                                      <<*7564>>09025000
$page  "UNCALLABLE UTILITIES : SET PSIF"                       <<06212>>09030000
procedure set'psif(pcbpt,flag);                                         09035000
value pcbpt,flag;                                                       09040000
integer pcbpt;                                                          09045000
logical flag;                                                           09050000
option privileged,uncallable;                                           09055000
                                                                        09060000
comment                                                                 09065000
                                                                        09070000
set'psif sets a flag in the pseudo-interrupt field of                   09075000
pcbpt's pcb entry,provided no more urgent pi is in effect.              09080000
if the process is impeded, holding a sir, critical, or                  09085000
executing system code, the piovrflag is set.  otherwise,                09090000
the process is queued into the dispq, so it will be swapped             09095000
in and a marker to pseudoint put on its stack before launch.            09100000
                                                                        09105000
;                                                                       09110000
                                                                        09115000
begin                                                                   09120000
entry clear'psif;                                                       09125000
logical setting:=false,                                                 09130000
        delay:=false;                                                   09135000
                                                                        09140000
disable;                                                                09145000
setting:=true;                                                          09150000
x:=pcbpt+procstatewordnum;                                              09155000
tos:=pcb(x):=logical(pcb(x)) lor flag.piflagsfield;                     09160000
tos:=tos.piflagsfield&lsl(9);                                           09165000
asmb(scan 0;del,ldxa);                                                  09170000
x:=pcbpt+piinfowordnum;                                        <<06650>>09175000
if s0 >= pcb(x).psimfield then pcb(pcbpt+procstatewordnum)              09180000
.piflagsfield:=0 <<more urgent soft interrupt is pending>> else         09185000
   begin                                                                09190000
   <<if hk,sk or stop, clear father and son wait flags>>                09195000
   if s0 < 3 then spcbabortwake:=0;                            <<03041>>09200000
   if tos=5 and log(spcbwakesoft) then <<c y preempt pause/io>><<03041>>09205000
      spcbnoncritwait:=0;                                      <<03041>>09210000
   if logical(pcb(pcbpt+resabortinfowordnum)).hassirflag                09215000
   or logical(pcb(pcbpt+resabortinfowordnum)).critflag                  09220000
   or logical(pcb(pcbpt+wakemaskwordnum)).impededwaitflag               09225000
   or logical(pcb(pcbpt+stkinfowordnum)).insystemflag then              09230000
      begin <<pseudo-interrupt must be delayed>>                        09235000
      delay:=true;                                                      09240000
      pcb(pcbpt+resabortinfowordnum).piovrflag:=1;                      09245000
      end;                                                              09250000
   end;                                                                 09255000
                                                                        09260000
clear'psif:                                                             09265000
                                                                        09270000
if not setting then                                                     09275000
   begin  <<clearing>>                                                  09280000
   disable;                                                             09285000
   x:=pcbpt+procstatewordnum;                                           09290000
   tos:=pcb(x):=logical(pcb(x)) land not flag.piflagsfield;             09295000
   if tos.piflagsfield = 0                                              09300000
   then pcb(pcbpt+resabortinfowordnum).piovrflag:=0;                    09305000
   end;                                                                 09310000
                                                                        09315000
readyprocess(pcbpt);                                           <<03041>>09320000
end  <<procedure set'psif>>;                                            09325000
$page "SOFTWARE INTERRUPTS.  DATA STRUCTURES."                          09330000
<<                                                                      09335000
                                                                        09340000
soft interrupt queue structure.                                         09345000
                                                                        09350000
                   msg harbor                                           09355000
   ...........    ............                                          09360000
   .         .    .port zero .    ........    ........   ........       09365000
   .  pcb    .    ............    .system.    .system.   .system.       09370000
   .         .--->.port one  .--->.soft  .--->.soft  .-->.soft  .       09375000
   ...........    ............    .int 0 .    .int 1 .   .int 2 .       09380000
                  .port two  .-   ........    ........   ........       09385000
                  ............                                          09390000
                               -                                        09395000
                                                                        09400000
                                - ........    ........                  09405000
                                  .user  .    .user  .                  09410000
                                 >.soft  .--->.soft  .                  09415000
                                  .int 0 .    .int 1 .                  09420000
                                  ........    ........                  09425000
                                                                        09430000
                                                                        09435000
soft interrupt queue entry format.                                      09440000
                                                                        09445000
     ...............................                                    09450000
   0 . soft int msg word zero      . 0                                  09455000
     ...............................                                    09460000
   1 . soft int msg word one       . 1                                  09465000
     ...............................                                    09470000
   2 . int handler's plabel        . 2                                  09475000
     ...............................                                    09480000
   3 . soft int subtype            . 3                                  09485000
     ...............................                                    09490000
                                                                        09495000
>>                                                                      09500000
$page "PCB FIELDS USED BY SOFTWARE INTERRUPTS."                         09505000
<<                                                                      09510000
                                                                        09515000
process control block fields.                                           09520000
----------------------------                                            09525000
                                                                        09530000
                                                                        09535000
field name    location      new  description                            09540000
------------- ------------  ---- --------------------------------       09545000
                                                                        09550000
spcbcritsir    pcb.(2:2)     no   nonzero if the process is             09555000
                                  critical or with sir.                 09560000
                                                                        09565000
spcbpiovrflag  pcb.(4:1)     no   set when the execution of the         09570000
                                  soft interrupt must be postponed      09575000
                                  due to the process's being            09580000
                                  critical, with sir, or impeded.       09585000
                                  tells the appropriate kernel          09590000
                                  procedure to enter pseudoint.         09595000
                                                                        09600000
spcbdelaysoft  pcb.(14:1)    yes  set when the execution of the         09605000
                                  soft interrupt must be delayed -      09610000
                                  critical, impeded, with sir,          09615000
                                  system code, or privileged code.      09620000
                                  this bit tells the bounds             09625000
                                  violation procedure in inin that      09630000
                                  a soft interrupt is pending.          09635000
                                  the dispatcher ignores this bit.      09640000
                                                                        09645000
spcbwaitfield  pcb(4).(0:12) no   indicates which events (if any)       09650000
                                  that the user process is waiting      09655000
                                  on.  does not include system          09660000
                                  events such as memory wait.           09665000
                                                                        09670000
spcbimpede     pcb(4).(12:1) no   set when the process is impeded.      09675000
                                                                        09680000
spcbpsim       pcb(8).(0:3)  no   current value of process's            09685000
                                  pseudo interrupt state.               09690000
                                                                        09695000
spcbwakesoft   pcb(8).(3:1)  yes  set on when the process will          09700000
                                  accept the soft interrupt even        09705000
                                  though it is waiting on other         09710000
                                  events.                               09715000
                                                                        09720000
spcbsoftint    pcb(9).(9:1)       set when the dispatcher (and          09725000
                                  pseudoint) should be aware of a       09730000
                                  pending soft interrupt.               09735000
                                                                        09740000
spcbpiflags    pcb(9).(10:6) no   specifies which of the six,           09745000
                                  independent pseudo interrupts         09750000
                                  may be pending against the            09755000
                                  process.                              09760000
                                                                        09765000
spcballowsoft  pcb(13).(7:1) yes  on implies that the process will      09770000
                                  process user soft interrupts.  a      09775000
                                  zero value postpones processing       09780000
                                  of user soft interrupts (but not      09785000
                                  system soft interrupts).  this        09790000
                                  bit is managed by the user            09795000
                                  through fintstate and fintexit.       09800000
>>                                                                      09805000
$page "SOFTWARE INTERRUPT MMSTAT ENTRY FORMATS."                        09810000
<<                                                                      09815000
                                                                        09820000
mmstat entry formats.                                                   09825000
--------------------                                                    09830000
                                                                        09835000
mmstat tracing for the following types is enabled only if the           09840000
"monitoring" has been turned on by the mon command.                     09845000
                                                                        09850000
type          number  word 0       word 1        word 2                 09855000
------------- ------- ------------ ------------- ---------------        09860000
                                                                        09865000
cause soft    240     (0:4)  level msg word one  msg word two           09870000
interrupt             (4:2)  type                                       09875000
                      (6:2)  stype                                      09880000
                      (8:8)  pin                                        09885000
                                                                        09890000
pseudoint     241     (0:8)  type  msg word one  msg word two           09895000
                      (8:8)  stype                                      09900000
                                                                        09905000
                                                                        09910000
build stack   242     plabel       preg word of  status word of         09915000
                                   prev marker   prev marker            09920000
                                                                        09925000
change state  243     (14:1) old   user's        user's status          09930000
                             state p register    register               09935000
                      (15:1) new                                        09940000
                             state                                      09945000
                                                                        09950000
timeout       244     compltn type 16 msb of     16 lsb of              09955000
                      0 timeout    timeout (ms)  timeout (ms)           09960000
                      1 no trlx                                         09965000
                      2 control y                                       09970000
                        soft int                                        09975000
                                                                        09980000
where:                                                                  09985000
                                                                        09990000
   level          the current status of the interrupt/process           09995000
                                                                        10000000
                  0  process is dying (hard kill or soft kill)          10005000
                                                                        10010000
                  1  other soft interrupts are pending                  10015000
                                                                        10020000
                  2  user interrupts are disabled                       10025000
                                                                        10030000
                  3  process is impeded, critical, and/or with          10035000
                     sir                                                10040000
                                                                        10045000
                  4  interrupt was against own process                  10050000
                                                                        10055000
                  5  process was either waiting or ready to             10060000
                     execute                                            10065000
                                                                        10070000
                  6  process would have been readied but wasn't         10075000
                     due to caller's specification                      10080000
                                                                        10085000
                  7  process was readied                                10090000
                                                                        10095000
   type           the type of the soft interrupt.                       10100000
                                                                        10105000
                  0  user                                               10110000
                                                                        10115000
                  1  system                                             10120000
                                                                        10125000
   stype          the subtype of the soft interrupt.                    10130000
                                                                        10135000
                  user type                                             10140000
                                                                        10145000
                    0  no preprocessing                                 10150000
                    1  file system interrupt                            10155000
                                                                        10160000
                  system type                                           10165000
                                                                        10170000
                    0  no preprocessing                                 10175000
                    1  debug invocation                                 10180000
                                                                        10185000
   old state      previous state of user soft interrupts                10190000
                                                                        10195000
                  0  disabled                                           10200000
                                                                        10205000
                  1  enabled                                            10210000
                                                                        10215000
   new state      new state of user soft interrupts                     10220000
                                                                        10225000
                  0  disabled                                           10230000
                                                                        10235000
                  1 enabled                                             10240000
                                                                        10245000
>>                                                                      10250000
$page "SOFTWARE INTERRUPTS.  PROLOGUE."                                 10255000
<<                                                                      10260000
                                                                        10265000
software interrupts                                                     10270000
-------------------                                                     10275000
                                                                        10280000
software interrupts provide a mechanism to interrupt the                10285000
executing sequence of a selected process, and to cause that             10290000
process to execute a specified sequence of code.  when the soft         10295000
interrupt code completes, the state of the interrupted process is       10300000
restored to that preceding the soft interrupt, and thus the             10305000
process resumes its normal execution.  multiple simultaneous            10310000
interrupts will be executed in a fifo manner.                           10315000
                                                                        10320000
soft interrupts may be initiated from any environment; including        10325000
the ics, since invoking soft interrupts does not wait the caller.       10330000
                                                                        10335000
                                                                        10340000
a) causing software interrupts.                                         10345000
                                                                        10350000
   the kernel procedure which issues soft interrupts against a          10355000
   target process is causesoftint.  currently it recognizes two         10360000
   types of soft interrupts:                                            10365000
                                                                        10370000
     1) user soft interrupts.                                           10375000
                                                                        10380000
        these interrupts are only processed while in the user's         10385000
        code.  additionally the user may enable/disable them with       10390000
        the fintstate intrinsic.  file system soft interrupts are       10395000
        are included in this type of interrupt.                         10400000
                                                                        10405000
     2) system soft interrupts.                                         10410000
                                                                        10415000
        system interrupts may execute while in system code (but         10420000
        not while critical, with sir, impeded, or waiting).  the        10425000
        user may not disable them.                                      10430000
                                                                        10435000
                                                                        10440000
   the subtype and plabel of the soft interrupt handler is              10445000
   supplied as an input parameter to causesoftint.  this plabel         10450000
   must specify code which is within the interrupted process's          10455000
   code address space.  a short control message (max of two             10460000
   words) may be sent along with the soft interrupt for use by          10465000
   the soft interrupt handler.                                          10470000
                                                                        10475000
   causesoftint first checks that the target process is healthy         10480000
   (not in soft or hard kill mode).  it then sends a message to         10485000
   the process's appropriate soft interrupt queue.  each queue is       10490000
   actually a kernel "in core" ipc port.  user interrupts are           10495000
   sent to port number one whereas system interrupts go to port         10500000
   number two.                                                          10505000
                                                                        10510000
   if this is the first message in the queue and there are no           10515000
   other soft interrupts pending then:                                  10520000
                                                                        10525000
     1. process is not critical, with sir, impeded, or waiting.         10530000
                                                                        10535000
        the soft interrupt bit is set in its pcb.  since it is not      10540000
        waiting, it must already be on the dispatcher queue so that     10545000
        no further action is required.                                  10550000
                                                                        10555000
     2. process is not critical, with sir, or impeded; but it is        10560000
        waiting.                                                        10565000
                                                                        10570000
        if the "wake soft interrupt" bit is set in the pcb, then        10575000
        the process can handle the soft interrupt even though it is     10580000
        waiting on some other event.  the wake-soft-int bit is reset    10585000
        (thus signaling the process that it was awakened by a           10590000
        soft interrupt).  additionally its wait field is cleared and    10595000
        the "delay soft interrupt" bit is set in the pcb.               10600000
                                                                        10605000
        processes which are waiting and do not have the                 10610000
        wake-soft-interrupt bit set must be allowed to                  10615000
        finish their processing before the soft interrupt occurs.       10620000
        thus they should not be awakened until whatever they            10625000
        specified in their wait field occurs.  when the process         10630000
        is ready to launch, the dispatcher will notice the soft         10635000
        bit and launch the process into pseudoint.                      10640000
                                                                        10645000
     2. the process has some combination of critical, with sir,         10650000
        or impede.                                                      10655000
                                                                        10660000
        the delayed-soft-int bit and the pseudo-interrupt               10665000
        overflow bits are set in the pcb.  this cuts the                10670000
        dispatcher out of the picture but leaves marks such             10675000
        that when the inhibiting conditions are removed,                10680000
        pseudoint will be invoked.  that is, relsir and                 10685000
        resetcritical both look at the pseudoint overflow flag in       10690000
        the pcb and call pseudoint if the flag is set.                  10695000
                                                                        10700000
b) servicing soft interrupts                                            10705000
                                                                        10710000
   this subsection describes the action the target process takes        10715000
   to process a software interrupt.                                     10720000
                                                                        10725000
   dispatcher                                                           10730000
                                                                        10735000
      when the process is about to be launched by the dispatcher,       10740000
      the pcb soft interrupt bit is checked.  if it is set and          10745000
      the process is not critical or with sir, pseudoint is             10750000
      invoked.  note that relsir and resetcritical will invoke          10755000
      pseudoint later if the process was with sir or critical,          10760000
      respectively.                                                     10765000
                                                                        10770000
   first pseudoint invocation.                                          10775000
                                                                        10780000
      backing out of pause/iowait.                                      10785000
                                                                        10790000
         if the process was awakened by a soft interrupt instead        10795000
         of the expected event, then the kernel wait procedure          10800000
         will note this before exiting to its caller.  it notifies      10805000
         the caller with a ccg condition code.                          10810000
                                                                        10815000
         iowait and pause will note that a soft interrupt               10820000
         occurred, undo any processing they had done (for               10825000
         example, pause will cancel its timeout), set the               10830000
         caller's stack marker to recall the intrinsic, and             10835000
         invoke pseudoint by causing a bounds violation through         10840000
         inin on the intrinsic's exit (for a complete description       10845000
         of this way, see the paragraph of the delayed pseudoint        10850000
         execution below).                                              10855000
                                                                        10860000
      system soft interrupts.                                           10865000
                                                                        10870000
         as a general rule these interrupts are executed straight       10875000
         away.  they are "pcaled" rather than being exited into.        10880000
                                                                        10885000
         these interrupt procedures must be coded in one of three       10890000
         ways:                                                          10895000
                                                                        10900000
            1. procedure inthandler;                                    10905000
                                                                        10910000
            2. procedure inthandler(msg)                                10915000
               value msg;                                               10920000
               integer msg;                                             10925000
                                                                        10930000
            3. procedure inthandler(msg0,msg1);                         10935000
               value msg0,msg1;                                         10940000
               integer msg0,msg1;                                       10945000
                                                                        10950000
         the above procedure head declarations are for zero, one,       10955000
         and two message parameters, respectively.                      10960000
                                                                        10965000
         software interrupts with nonzero subtype values will           10970000
         have subtype-specific preprocessing done for them.             10975000
         since system soft interrupts have their own queue, they        10980000
         are not delayed if user soft interrupts are delayed.           10985000
         all system interrupts are processed before user                10990000
         interrupts are considered.  note also that system              10995000
         interrupts occur without the process's user code being         11000000
         aware of it.                                                   11005000
                                                                        11010000
      user soft interrupts                                              11015000
                                                                        11020000
         pseudoint checks that the user has soft interrupts             11025000
         enabled.  if not then pseudoint returns to the interrupted     11030000
         code.  when the user reenables soft interrupts with            11035000
         either fintstate or fintexit, they will check for any          11040000
         pending soft interrupts by testing the user soft               11045000
         interrupt port.                                                11050000
                                                                        11055000
         next it is determined if the interrupt can be executed         11060000
         right away.  that is, the process cannot be executing in       11065000
         system code and if we are interrupting privileged user         11070000
         code, the user interrupt procedure must be privileged.         11075000
         if the procedure is compatible then the code described         11080000
         in "Second PSEUDOINT invocation" is executed.  delayed         11085000
         execution is effected by setting the delayed soft              11090000
         interrupt bit in the pcb and by setting bit zero of the        11095000
         p register save word of the first eligible stack marker.       11100000
         the exit instruction against this stack marker will            11105000
         cause a bounds violation trap to inin, which will note         11110000
         that a soft interrupt is pending and invoke pseudoint at       11115000
         its secondary entry point, delayedint.                         11120000
                                                                        11125000
      second pseudoint invocation.                                      11130000
                                                                        11135000
         pseudoint gets the interrupt's first in-core ipc message       11140000
         and:                                                           11145000
                                                                        11150000
           1. performs any required preprocessing (subtype <> 0),       11155000
                                                                        11160000
           2. disables user soft interrupts,                            11165000
                                                                        11170000
           3. builds the stack marker for the interrupt handler,        11175000
                                                                        11180000
           4. and exits through it.                                     11185000
                                                                        11190000
>>                                                                      11195000
$page "DATA STRUCTURE INDEPENDENT INFORMATION PROCEDURES"      <<01644>>11200000
$page "SOFT INTERRUPTS. BUILDSTACKMARKER PROCEDURE."                    11205000
procedure buildstackmarker(loc,plabel);                        <<03041>>11210000
value loc,plabel;                                                       11215000
                                                                        11220000
<<function                                                              11225000
  builds a stack marker based on the plabel parameter.>>                11230000
                                                                        11235000
<<input>>                                                               11240000
  integer                                                               11245000
    loc;                  <<location of the desired stack marker        11250000
                            relative to the caller's q.  it             11255000
                            is the number of words from the             11260000
                            caller's q+0 to the first word              11265000
                            of the stack marker (x register save).      11270000
                            this word must be positive.>>               11275000
  logical                                                               11280000
    plabel;               <<trap procedure's plabel.>>                  11285000
                                                                        11290000
<<output                                                                11295000
  the desired stack marker>>                                            11300000
                                                                        11305000
option privileged,uncallable;                                           11310000
                                                                        11315000
begin                                                                   11320000
integer                                                                 11325000
   deltaq=q+0,index,cstn;                                               11330000
array                                                                   11335000
   stack(*)=q+0;                                                        11340000
define                                                                  11345000
   privinterruptee = log(stack(-stack-1).(0:1))#;                       11350000
                                                                        11355000
                                                                        11360000
<<initialize>>                                                          11365000
index:=loc-deltaq;                                                      11370000
if globaltraceflag then                                                 11375000
   mmstat'(mmbuildmarker,plabel,stack(-deltaq-2),stack(x+1),   <<06948>>11380000
          0,0,0);                                              <<06948>>11385000
                                                                        11390000
<<configure the status word>>                                           11395000
tos:=plabel.(8:8);                                             <<06104>>11400000
tos.(1:1):=1;  <<enable interrupts>>                                    11405000
if privinterruptee then  <<interruptee privileged?>>                    11410000
   tos.(0:1):=1  <<yes, then so shall the trap procedure>>              11415000
else                                                                    11420000
   begin  <<no, get trap handler's true mode from the cst>>             11425000
      x:=cstconv(plabel,0);                                    <<06104>>11430000
      tos.(0:1):=dst(x).(1:1);                                 <<06104>>11435000
   end;                                                                 11440000
stack(index+2):=tos;  <<status register>>                               11445000
                                                                        11450000
<<configure remainder of the marker>>                                   11455000
stack(index):=0;  <<x register>>                                        11460000
stack(index+1):=convextlabeltodeltap(plabel); <<p-register>>   <<06104>>11465000
if mappingfirmware then                                        <<06104>>11470000
   stack(index+1).(1:1):=plabel.(0:1); <<mapping flag>>        <<06104>>11475000
stack(index+3):=loc+3;  <<delta q>>                                     11480000
                                                                        11485000
<<hook into the new marker>>                                            11490000
deltaq:=deltaq-loc-3;                                                   11495000
end;  <<buildstackmarker>>                                              11500000
logical procedure system'segment(status',deltap);              <<*7950>>11505000
value status',deltap;                                          <<*7950>>11510000
logical status',deltap;                                        <<*7950>>11515000
begin                                                          <<*7950>>11520000
integer                                                        <<*7950>>11525000
   seg'num;                                                    <<*7950>>11530000
system'segment := false;                                       <<*7950>>11535000
tos := 0d; << for the return of mappedcsttophycst >>           <<*8009>>11540000
tos := status'.(8:8);                                          <<*7950>>11545000
tos.(0:1) := deltap.(1:1);                                     <<*7950>>11550000
tos := curprc;                                                 <<*7950>>11555000
tos := mappedcsttophycst(*,*);                                 <<*7950>>11560000
delb;                                                          <<*7950>>11565000
seg'num := tos;                                                <<*7950>>11570000
if marker'is'sl'seg(status',deltap,0) and                      <<*7950>>11575000
   log(sl(seg'num & lsl(2) + 1).systemflag) then               <<*7950>>11580000
   system'segment := true;                                     <<*7950>>11585000
end;                                                           <<*7950>>11590000
$page "SOFTWARE INTERRUPTS.  PSEUDOINT PROCEDURE."                      11595000
procedure pseudoint;                                           <<03041>>11600000
                                                                        11605000
<<processes all pseudo interrupts and software interrupts.  assumes     11610000
  that it is called pesudodisabled with interrupts off.  db may be      11615000
  at any data segment (including system db and the stack).>>            11620000
                                                                        11625000
option privileged,uncallable;                                           11630000
                                                                        11635000
begin                                                                   11640000
equate                                                                  11645000
   return0        = %31400,                                             11650000
   stdinlogdev    = 8,                                         <<06669>>11655000
   abtyp          = [8/1,8/5],  <<hard kill abort code>>                11660000
   enablelaunch   = true,                                               11665000
   nopenable      = false,                                              11670000
   primaryentry   = true,                                               11675000
   nowaitdone     = -1,                                                 11680000
   privmode       = false;                                              11685000
                                                                        11690000
equate                                                                  11695000
   softinterrupt  = 7;                                                  11700000
                                                                        11705000
entry                                                                   11710000
   delayedint;                                                          11715000
integer                                                                 11720000
   cutback:=0;  <<must be at q+1>>                                      11725000
double                                                                  11730000
  msg0,msg1;  <<must be at q+2>>                                        11735000
integer                                                                 11740000
   newinterrupt,son,next,main,stackmarkernum,depthlimit,       <<06650>>11745000
   i,pcbxloc,x=x,deltaq,markernum,pcbpt,plabel=msg1+1,         <<06650>>11750000
   svalue;                                                              11755000
logical                                                                 11760000
   pxfixedloc,                                                 <<06669>>11765000
   processrequest;                                                      11770000
                                                                        11775000
                                                                        11780000
subroutine pexit(enablelaunch);                                         11785000
value enablelaunch;                                                     11790000
logical enablelaunch;                                                   11795000
   begin                                                                11800000
   if enablelaunch then penable;                                        11805000
   tos:=return0+cutback;                                                11810000
   asmb(xeq);                                                           11815000
   end;  <<pexit>>                                                      11820000
subroutine initialize;                                                  11825000
   begin  <<initialize local variables>>                                11830000
   pxfixed;                                                             11835000
   pcbpt := (curprc);                                          <<06650>>11840000
   end;  <<initialize>>                                                 11845000
                                                                        11850000
                                                                        11855000
logical subroutine findtargetmarker(nonpriv);                           11860000
value nonpriv;                                                          11865000
                                                                        11870000
<<scans backward through the stack until it finds the first             11875000
  suitable user stack marker.>>                                         11880000
                                                                        11885000
<<input>>                                                               11890000
  logical                                                               11895000
    nonpriv;          <<true if user procedure must be executing        11900000
                        in non-privileged mode.>>                       11905000
                                                                        11910000
<<output                                                                11915000
  findtargetmarker      true  - marker was the one at q+0               11920000
                        false - marker was further back, bit zero       11925000
                                of the p-register save word is set      11930000
                                to force the exit into inin (with       11935000
                                bounds violation).>>                    11940000
                                                                        11945000
   begin                                                                11950000
   push(q,dl);                                                          11955000
   depthlimit:=tos-tos;   <<set maximum stack depth limit>>             11960000
   i:=-1; markernum:=0;                                                 11965000
                                                                        11970000
   <<locate the marker.  cannot be:                                     11975000
     1. in system sl                                                    11980000
     2. have system bit set on in cst                                   11985000
     3. privileged, if trap procedure is user mode>>                    11990000
   while system'segment(stack(i),stack(i-1)) or                <<*7950>>11995000
         nonpriv and stack(i)&csl(1) do                        <<*7950>>12000000
      begin  <<index back to the next marker>>                          12005000
      markernum:=markernum+1;                                           12010000
      deltaq:=stack(i+1);                                               12015000
      if deltaq < 4 or -(i:=i-deltaq) > depthlimit then                 12020000
         abort(markernum&lsl(8),22,0);  <<bad marker in stack>>         12025000
      end;                                                              12030000
                                                                        12035000
   <<tally the result>>                                                 12040000
   if markernum = 0 then                                                12045000
      findtargetmarker:=true                                            12050000
   else                                                                 12055000
      stack(i-1).(0:1):=1;  <<cause trap to inin upon user mode>>       12060000
   end;  <<findtargetmarker>>                                           12065000
subroutine specialsystemtrap(plabel);                                   12070000
value plabel;                                                           12075000
logical plabel;                                                         12080000
                                                                        12085000
<<causes trap to occur on the first user stack marker.                  12090000
  note - if successful, it exits this procedure.>>                      12095000
                                                                        12100000
   begin                                                                12105000
   if findtargetmarker(privmode) then                                   12110000
      begin  <<can execute the interrupt now>>                          12115000
      if log(portstatus(systemsgport))                                  12120000
      or log(portstatus(usermsgport)) and log(spcballowsoft) then       12125000
         begin  <<another soft interrupt is pending>>                   12130000
         stack(-1).(0:1):=1;  <<trap to inin on si proc's exit>>        12135000
         spcbdelaysoft:=1;                                              12140000
         end;                                                           12145000
      x:=plabel;                                                        12150000
      receivemsg(systemsgport,maxmsglen,deletemsg);                     12155000
      buildstackmarker(1,x); cutback:=0;                                12160000
      pexit(nopenable);                                                 12165000
      end                                                               12170000
   else                                                                 12175000
      begin  <<must postpone the execution>>                            12180000
      disable;                                                          12185000
      spcbdelaysoft:=1;                                                 12190000
      enable;                                                           12195000
      end;                                                              12200000
   end;  <<specialsystemtrap>>                                          12205000
integer subroutine processysoftint;                                     12210000
                                                                        12215000
<<eat away at the process's system soft interrupt queue until           12220000
  either:                                                               12225000
                                                                        12230000
   1. the queue is exhausted (returns true),                            12235000
                                                                        12240000
   2. or the head interrupt is stalled (returns false).                 12245000
                                                                        12250000
  message format (s-register relative)                                  12255000
  s0    - request dependent processing type                             12260000
  s1    - interrupt procedure's plabel                                  12265000
  s2,s3 - interrupt-type dependent                                      12270000
                                                                        12275000
  note - the general case is pcal the trap procedure from this          12280000
         subroutine (rather than building a stack marker and            12285000
         exiting through it.>>                                          12290000
                                                                        12295000
   begin                                                                12300000
   <<initialize>>                                                       12305000
   processrequest:=true;                                                12310000
                                                                        12315000
   while processrequest                                                 12320000
   and (processysoftint:=portstatus(-1)) = systemsgport do              12325000
      begin  <<have an interrupt to process>>                           12330000
      push(s); svalue:=tos; <<trap procs may not delete their params>>  12335000
      asmb(adds maxmsglen);  <<so save the proper s value.>>            12340000
      receivemsg(systemsgport,maxmsglen,savemsg);                       12345000
      if <> then suddendeath(uglypseudoint);                            12350000
      if globaltraceflag then                                           12355000
         mmstat'(mmprocess,sysoftint cat s0(0:8:8),s3,s2,      <<06948>>12360000
                 0,0,0);                                       <<06948>>12365000
      tos:=tos.(1:15); <<mask off mode bit>>                   <<06104>>12370000
      case tos of                                                       12375000
         begin  <<request dependent processing>>                        12380000
         ;                    <<0 - no operation>>                      12385000
         begin                <<1 - debug>>                             12390000
         specialsystemtrap(log(@debug));                                12395000
         processrequest:=false;                                         12400000
         end;                                                           12405000
         end;  <<case>>                                                 12410000
      if processrequest then                                            12415000
         begin  <<invoke the trap's handler>>                           12420000
         receivemsg(systemsgport,maxmsglen,deletemsg); del;             12425000
         if s0 <> 0 then asmb(pcal 0);                                  12430000
         end;                                                           12435000
      tos:=svalue; set(s);                                              12440000
      end;                                                              12445000
                                                                        12450000
   end;  <<processysoftint>>                                            12455000
                                                                        12460000
                                                                        12465000
subroutine processoftint;                                               12470000
                                                                        12475000
<<process all the process's software interrupts.>>                      12480000
                                                                        12485000
   begin                                                                12490000
   disable; spcbsoftint:=0; spcbdelaysoft:=0; enable;                   12495000
   if processysoftint = usermsgport and log(spcballowsoft) then         12500000
      begin  <<ok to process user mode soft interrupts>>                12505000
      <<get head soft interrupt                                         12510000
        message format                                                  12515000
        s0    - request dependent processing type  (subtype)   ((*msg2))12520000
                causesoftint actually uses bit 0 of the        ((*msg2))12525000
                subtype to signify priv/non-priv. this info    ((*msg2))12530000
                will be used by findtargetmarker.              ((*msg2))12535000
        s1    - interrupt procedure's plabel.                  ((*msg2))12540000
        s2,s3 - interrupt dependent type.                    >><<*8867>>12545000
                                                               <<*8867>>12550000
      asmb(adds 4);                                                     12555000
      receivemsg(usermsgport,4,savemsg);                                12560000
      if <> then suddendeath(uglypseudoint);                            12565000
      if globaltraceflag then                                           12570000
         mmstat'(mmprocess,usersoftint cat s0(0:8:8),s3,s2,    <<06948>>12575000
                0,0,0);                                        <<06948>>12580000
                                                               <<*8867>>12585000
      << note: s0 is the subtype field from causesoftint >>    <<*8867>>12590000
                                                               <<*8867>>12595000
      if findtargetmarker(s0.(0:1)) then                       <<*8867>>12600000
         begin  <<will exit into the trap procedure>>                   12605000
         receivemsg(usermsgport,4,deletemsg);                           12610000
         spcballowsoft:=0;                                              12615000
                                                               <<*8867>>12620000
                                                               <<*8867>>12625000
         << get rid of the mode (i.e. priv/non priv) of the >> <<*8867>>12630000
         << interrupt procedure and save the file number.   >> <<*8867>>12635000
                                                               <<*8867>>12640000
         s0 := s0.(1:15); << get rid of priv/non-priv bit.  >> <<*8867>>12645000
         case tos of                                                    12650000
            begin  <<request dependent processing>>                     12655000
            ;                                     <<0 - no action>>     12660000
            begin                                 <<1 - msg file>>      12665000
                                                               <<*8867>>12670000
            << note : s1 is really the file number           >><<*8867>>12675000
                                                               <<*8867>>12680000
            fcprepaft(s1,nowaitdone);                                   12685000
            tos:=dqm3; tos:=dqm1;  <<remove cutback parms (inin call)>> 12690000
            x:=-cutback+1;         <<but leave room for file number>>   12695000
            stack(x):=tos-cutback+1; stack(x:=x-1):=tos;                12700000
            stack(x:=x-1):=tos; stack(x:=x-1):=tos;                     12705000
            push(q); tos:=tos+x+3; set(q); initialize;                  12710000
            qm4:=s1;  <<return file number>>                            12715000
            end;                                                        12720000
                                                               <<06947>>12725000
            begin                        <<2 - port procedure>><<06947>>12730000
            fcprepaft(s1,-s2);  << - iowait port index >>      <<06947>>12735000
            tos:=dqm3; tos:=dqm1;  <<remove cutback parms>>    <<06947>>12740000
            x:=-cutback+1;   <<but leave room for file number>><<06947>>12745000
            stack(x):=tos-cutback+1; stack(x:=x-1):=tos;       <<06947>>12750000
            stack(x:=x-1):=tos; stack(x:=x-1):=tos;            <<06947>>12755000
            push(q); tos:=tos+x+3; set(q); initialize;         <<06947>>12760000
            qm4:=s1;  <<return file number>>                   <<06947>>12765000
            end;                                               <<06947>>12770000
            end;  <<case>>                                              12775000
         buildstackmarker(1,s0); cutback:=0;                            12780000
         del; ddel;                                                     12785000
         end                                                            12790000
      else                                                              12795000
         begin  <<must defer processing of the interrupt>>              12800000
         disable; spcbdelaysoft:=1; enable;                             12805000
         asmb(subs 4);                                                  12810000
         end;                                                           12815000
      end;                                                              12820000
   end;  <<processoftint>>                                              12825000
                                                                        12830000
                                                                        12835000
subroutine processbreak;                                                12840000
   begin                                                                12845000
   <<get logical device number for $stdin>>                             12850000
   push(q,dl);                                                          12855000
   asmb(xch,sub;dup,stax;decx);                                         12860000
   tos:=-qarray(x);                                            <<06635>>12865000
   asmb(add);                                                  <<06650>>12870000
   tos:=tos+stdinlogdev;                                                12875000
   asmb(stax);                                                          12880000
   tos:=qarray(x);                                             <<06635>>12885000
   if resabortinfo.ritbrkflag <> 0 then                        <<06650>>12890000
      begin                                                             12895000
      disable;                                                          12900000
      piinfo.oafield := 0;                                     <<06650>>12905000
      enable;                                                           12910000
      end;                                                              12915000
   attachio(s0,0,0,0,30,0,1,0,%13); <<settmode>>                        12920000
   sysbreak;                                                            12925000
   attachio(s0,0,0,0,30,0,0,0,%13); <<resettmode>>                      12930000
   del;                                                                 12935000
   pdisable;                                                            12940000
   piinfo.psimfield := 7;                                      <<06650>>12945000
                                                                        12950000
   if soninfo = 0 then                                         <<06650>>12955000
      begin  <<no existing son>>                                        12960000
      if resabortinfo.ritbrkflag <> 0 then                     <<06650>>12965000
         begin  <<rit break>>                                           12970000
         resabortinfo.ritbrkflag := 0;                         <<06650>>12975000
         if piinfo.oafield <> 3 then                           <<06650>>12980000
            begin                                                       12985000
            penable;                                                    12990000
            wait(%40,0);                                                12995000
            pexit(nopenable);                                           13000000
            end                                                         13005000
         else                                                           13010000
            pexit(enablelaunch);                                        13015000
         end                                                            13020000
      else                                                              13025000
         pexit(enablelaunch);                                           13030000
      end;                                                              13035000
                                                                        13040000
   main := next := (curprc)/pcbsize;                           <<06650>>13045000
   while (next:=family(next,main))<>main do                             13050000
      clear'psif(next*pcbsize,4);                                       13055000
   end;  <<processbreak>>                                               13060000
                                                                        13065000
                                                                        13070000
subroutine analyzeinterrupt;                                            13075000
                                                                        13080000
<<gets the highest priority pending pseudo/soft interrupt.              13085000
  returns the interrupt type in "NEWINTERRUPT.">>                       13090000
                                                                        13095000
   begin                                                                13100000
   tos := procstate&lsl(10); << pi bits into msb of tos >>     <<06650>>13105000
   if <> then                                                           13110000
      begin  <<pseudo interrupt occurred>>                              13115000
      spcbpiflags:=0;                                                   13120000
      asmb(scan 0); del;                                                13125000
      newinterrupt:=x+1;                                                13130000
      if newinterrupt >= spcbpsim then                                  13135000
         pexit(enablelaunch); <<already have more important pseudo int>>13140000
      spcbpsim:=                                                        13145000
       if newinterrupt=hardkillvalue then normalvalue else newinterrupt;13150000
      if newinterrupt <= softkill then                                  13155000
         begin  <<process is dying, forget soft interrupts>>            13160000
         spcbdelaysoft:=0;                                              13165000
         spcbsoftint:=0;                                                13170000
         end;                                                           13175000
      end                                                               13180000
   else                                                                 13185000
      begin  <<assume soft interrupt occurred>>                         13190000
      del;                                                              13195000
      if spcbpsim < controlyvalue then                                  13200000
         begin  <<already executing a pseudo interrupt>>                13205000
         if spcbpsim < softkill then                                    13210000
            begin  <<process is dying, forget soft int>>                13215000
            spcbsoftint:=0;                                             13220000
            spcbdelaysoft:=0;                                           13225000
            pexit(enablelaunch);                                        13230000
            end;                                                        13235000
         end;                                                           13240000
      newinterrupt:=softinterrupt;                                      13245000
      end;                                                              13250000
   end;  <<analyzeinterrupt>>                                           13255000
pcbpt := (curprc);                                             <<06650>>13260000
if procstate.stovflag <> 0 then                                <<07320>>13265000
   begin                                                       <<07320>>13270000
   disable;                                                    <<07320>>13275000
   resabortinfo.stovabortflag := 1;                            <<07320>>13280000
   enable;                                                     <<07320>>13285000
   penable;    << always pdisabled when get here!!!!! >>       <<*7564>>13290000
   abort([8/2,8/4],0,0);                                       <<07320>>13295000
   end;                                                        <<07320>>13300000
if primaryentry then                                                    13305000
   begin  <<* * pri entry (causesoftint,dispatch,resetcritical,relsir>> 13310000
   initialize;                                                          13315000
   spcbpiovrflag:=0;                                                    13320000
   analyzeinterrupt;                                                    13325000
   penable; enable;                                                     13330000
   end                                                                  13335000
else                                                                    13340000
   begin  <<* * secondary entry (inin), enabled & pseudoenabled>>       13345000
   delayedint:                                                          13350000
   push(q); tos:=tos-stack; set(q);  <<delete inin's stack marker>>     13355000
   initialize;                                                          13360000
   <<get cause of interrupt>>                                           13365000
   pxfxdcy := 0;                                               <<07365>>13370000
   if <> and (pxfxctlyplbl <> 0) then                          <<06635>>13375000
      newinterrupt:=controlyvalue                                       13380000
   else if log(spcbdelaysoft) then                                      13385000
      newinterrupt:=softinterrupt                                       13390000
   else                                                                 13395000
      pexit(nopenable);                                                 13400000
   end;                                                                 13405000
                                                                        13410000
<<process the pseudointerrupt>>                                         13415000
case newinterrupt-1 of                                                  13420000
   begin                                                                13425000
   begin  <<** hard kill>>                                              13430000
   <<process killed by ucop, quitprog situation>>                       13435000
   mmstat'(mmprocess,hardkiller,0,0,0,0,0);                    <<06948>>13440000
   abort(abtyp,0,0);                                                    13445000
   end;                                                                 13450000
                                                                        13455000
   begin  <<** soft kill>>                                              13460000
   mmstat'(mmprocess,softkiller,0,0,0,0,0);                    <<06948>>13465000
   terminate;                                                           13470000
   end;                                                                 13475000
                                                                        13480000
   begin  <<** stop>>                                                   13485000
   suddendeath(uglypseudoint);                                          13490000
   end;                                                                 13495000
                                                                        13500000
   begin  <<** hybernate>>                                              13505000
   suddendeath(uglypseudoint);                                          13510000
   end;                                                                 13515000
                                                                        13520000
   begin  <<** control y>>                                              13525000
   processysoftint;                                                     13530000
   plabel:=pxfxctlyplbl;                                       <<06635>>13535000
   if spcbwakesoft = 0 then                                             13540000
      begin                                                             13545000
      mmstat'(mmprocess,controly,0,0,0,0,0);                   <<06948>>13550000
      if findtargetmarker(pxfxctlytrp) then                    <<06635>>13555000
         begin                                                          13560000
         pxfxsiflag:=spcballowsoft;                            <<06635>>13565000
         disable; spcballowsoft:=0; enable; <<disable user soft int>>   13570000
         buildstackmarker(2,plabel); cutback:=0;                        13575000
         end                                                            13580000
      else                                                              13585000
         pxfxdcy := 1;                                         <<07365>>13590000
      end                                                               13595000
   else                                                                 13600000
      begin                                                    <<03787>>13605000
      spcbwakesoft := 0;                                       <<03787>>13610000
      pxfxdcy := 1; << pause/iowait have to clean first >>     <<07365>>13615000
      end;                                                     <<03787>>13620000
   end;                                                                 13625000
                                                                        13630000
   begin  <<** break>>                                                  13635000
   mmstat'(mmprocess,breaker,0,0,0,0,0);                       <<06948>>13640000
   processbreak;                                                        13645000
   <<cut off two stack markers>>                                        13650000
   comment the situation we are in is that of a ci which has   <<05019>>13655000
           been broken from a son wait. ci command executors   <<05019>>13660000
           should always do a joint call to awake and wait     <<05019>>13665000
           whenever command executors which spawn processes    <<05019>>13670000
           are written. the cutback on the stack will be than  <<05019>>13675000
           the number of parameters which awake has, namely 3  <<05019>>13680000
   ;                                                           <<05019>>13685000
   tos:=@stack-integer(stack)-integer(stack(-stack));                   13690000
   tos:=s0;                                                             13695000
   set(q,s);                                                            13700000
   tos := 3;       << cutback := 3, see comment above >>       <<07320>>13705000
   wait(2,0);  <<wait for son activation>>                              13710000
   end;                                                                 13715000
                                                                        13720000
   begin  <<** soft interrupt>>                                         13725000
   processoftint;                                                       13730000
   end;                                                                 13735000
   end;  <<case>>                                                       13740000
                                                                        13745000
pexit(nopenable);                                                       13750000
end;   <<pseudoint>>                                                    13755000
$page "SOFTWARE INTERRUPTS.  CAUSESOFTINT PROCEDURE."                   13760000
procedure causesoftint(pin,type,subtype,plabel,msglen,flags);  <<03041>>13765000
value pin,type,subtype,plabel,msglen,flags;                             13770000
                                                                        13775000
<<function                                                              13780000
  causes a soft interrupt to occur on the target process.>>             13785000
                                                                        13790000
<<input>>                                                               13795000
  integer                                                               13800000
    pin,                   <<process id number of target process.       13805000
                             zero implies own process.>>                13810000
    type,                  <<type of soft interrupt                     13815000
                             0 - interrupts processed only when         13820000
                                 user interrupts are enabled and the    13825000
                                 process is executing in user code      13830000
                                 (i.e., executing in %3xx code or user  13835000
                                 sl).                                   13840000
                             1 - interrupts processed in current state  13845000
                                 unless the target process:             13850000
                                 1) is waiting,                         13855000
                                 2) has a sir,                          13860000
                                 3) is impeded,                         13865000
                                 4) is critical,                        13870000
                                 5) or pseudo interrupt level           13875000
                                    is less than control y.             13880000
                             note that the above conditions only        13885000
                             delay the soft interrrupt, once they       13890000
                             go away the soft interrupt will occur.     13895000
                             multiple, simultaneous soft interrupts     13900000
                             are serviced in a fifo manner.  all type   13905000
                             ones are serviced before type zeroes.>>    13910000
    subtype,               <<type of preprocessing to be done by        13915000
                             pseudoint procedure.  a zero implies       13920000
                             no preprocessing.>>                        13925000
                          << (0:1) - execution context of    >><<*8867>>13930000
                          <<         user mode procedures.   >><<*8867>>13935000
                          <<         0 - o.k. execute in priv>><<*8867>>13940000
                          <<             user code.          >><<*8867>>13945000
                          <<         1 - can only execute in >><<*8867>>13950000
                          <<             non-priv user code. >><<*8867>>13955000
                          <<                                 >><<*8867>>13960000
                          << (1:15) - subtype info.          >><<*8867>>13965000
                                                               <<*8867>>13970000
    plabel,                << interrupt procedure's plabel.  >><<*8867>>13975000
                           << a zero implies no procedure.   >><<*8867>>13980000
    msglen;                <<# words in the message (max of 2 words)    13985000
                             note: the message is assumed to be         13990000
                                   located in the stack, just above     13995000
                                   the pin parameter.  it will be       14000000
                                   deleted by this procedure.>>         14005000
  logical                                                               14010000
    flags;                 <<(0:14) - reserved for future use, must     14015000
                                      be set to zero.                   14020000
                             (0:1)  - 0 - if appropriate place process  14025000
                                          on the ready list.            14030000
                                      1 - do not put on ready list>>    14035000
  <<db                       may be anywhere.>>                         14040000
                                                                        14045000
<<output                                                                14050000
    condition code                                                      14055000
       cce                   soft interrupt was set up.                 14060000
       ccl                   process is dying, no action was taken.     14065000
       ccg                   only returned when flags parameter         14070000
                             specifies no wake, ccg implies that        14075000
                             the process would have been placed         14080000
                             on the ready list had it not been          14085000
                             for the flags specification.>>             14090000
                                                                        14095000
option privileged,uncallable;                                           14100000
                                                                        14105000
begin                                                                   14110000
equate                                                                  14115000
   return6        = %31406,                                             14120000
   nolaunch       = %100000,                                            14125000
   hybernate      = 4,                                                  14130000
   softintbase    = 1,                                                  14135000
   uglypseudoint  = 4,                                                  14140000
   maxmsglen      = 2;                                                  14145000
define                                                                  14150000
   usersoftint    = (type = 0)#,                                        14155000
   launchprocess  = (not flags.(15:1))#;                                14160000
                                                                        14165000
equate  <<mmstat definitions>>                                          14170000
   processdead    = 0,                                                  14175000
   othersoftints  = 1,                                                  14180000
   intdisabled    = 2,                                                  14185000
   impedecritsir  = 3,                                                  14190000
   ownprocess     = 4,                                                  14195000
   processwaitrdy = 5,                                                  14200000
   delaylaunch    = 6,                                                  14205000
   launched       = 7;                                                  14210000
define                                                                  14215000
   tlevel         = tmisc.(0:4)#,                                       14220000
   ttype          = tmisc.(4:2)#,                                       14225000
   tsubtype       = tmisc.(6:2)#,                                       14230000
   tpin           = tmisc.(8:8)#;                                       14235000
                                                                        14240000
double                                                                  14245000
   msg=pin-2;                                                           14250000
integer                                                                 14255000
   pcbpt;                                                               14260000
integer                                                                 14265000
  msg0=msg,msg1=msg+1,tmisc,level:=othersoftints;                       14270000
                                                                        14275000
                                                                        14280000
subroutine leavetracks;                                                 14285000
                                                                        14290000
<<function                                                              14295000
  leave tracks in process's pcb so that soft int will be                14300000
  processed at a later time.>>                                          14305000
                                                                        14310000
   begin                                                                14315000
   level:=impedecritsir;                                                14320000
   spcbpiovrflag:=1;                                                    14325000
   spcbdelaysoft:=1;                                                    14330000
   end;  <<leave tracks>>                                               14335000
                                                                        14340000
                                                                        14345000
subroutine interruptself;                                               14350000
                                                                        14355000
<<function                                                              14360000
  process soft interrupt generated against ourself.>>                   14365000
                                                                        14370000
   begin                                                                14375000
   level:=ownprocess;                                                   14380000
   spcbdelaysoft:=1;                                                    14385000
   enable;                                                              14390000
   pseudoint;                                                           14395000
   end;  <<interruptself>>                                              14400000
                                                                        14405000
                                                                        14410000
subroutine wakeprocess;                                                 14415000
                                                                        14420000
<<function                                                              14425000
  wake the target process.>>                                            14430000
                                                                        14435000
   begin                                                                14440000
   spcbnoncritwait:=0;                                                  14445000
   spcbdelaysoft:=1;                                                    14450000
   enable;                                                              14455000
   if spcbpsim > hybernate then                                         14460000
      begin  <<control y, break, or normal>>                            14465000
      if launchprocess then                                             14470000
         begin                                                          14475000
         level:=launched;                                               14480000
         readyprocess(pcbpt)                                            14485000
         end                                                            14490000
      else                                                              14495000
         begin                                                          14500000
         level:=delaylaunch;                                            14505000
         cc:=ccg;                                                       14510000
         end;                                                           14515000
      end;                                                              14520000
   end;  <<wakeprocess>>                                                14525000
                                                                        14530000
                                                                        14535000
subroutine sendsoftint;                                                 14540000
                                                                        14545000
<<does the mechanics of queueing the soft int and informing             14550000
  the target process.>>                                                 14555000
                                                                        14560000
   begin                                                                14565000
   cc:=cce;                                                             14570000
                                                                        14575000
   <<send the msg to the proper ipc port>>                              14580000
   case msglen of begin                                        <<f7736>>14585000
      <<0>> ;                                                  <<f7736>>14590000
      <<1>> tos:=msg1;                                         <<f7736>>14595000
      <<2>> tos:=msg;                                          <<f7736>>14600000
      end;                                                     <<f7736>>14605000
   tos:=plabel;                                                         14610000
   tos:=subtype;                                                        14615000
   sendmsg(pin,type+softintbase,msglen+2,nolaunch);                     14620000
                                                                        14625000
   <<check if the process needs to be notified of the interrupt>>       14630000
   if not log(spcbsoftint) and not log(spcbdelaysoft) then              14635000
      begin  <<no other soft interrupts pending>>                       14640000
      disable;  <<must disable int because of multi-field pcb words>>   14645000
      if log(spcballowsoft) or not usersoftint then                     14650000
         begin  <<process is interested>>                               14655000
         if (spcbcritsir<>0) or (spcbimpede<>0) then                    14660000
            leavetracks  <<process can't exec int right now>>           14665000
         else                                                           14670000
            begin  <<process will process int, check if should wake>>   14675000
            if (pcbpt = (curprc)) then                         <<06650>>14680000
               interruptself  <<caller specified himself>>              14685000
            else                                                        14690000
               begin  <<interrupt is on process other than ours>>       14695000
               spcbwakesoft:=0;                                         14700000
               if <> then                                               14705000
                  wakeprocess  <<proc asleep, ok to wake on soft int>>  14710000
               else                                                     14715000
                  begin  <<process is either 1) on rdy list (no need>>  14720000
                         <<to wake) or 2) waiting on another event>>    14725000
                  level:=processwaitrdy;                                14730000
                  spcbsoftint:=1;                                       14735000
                  end;                                                  14740000
               end;                                                     14745000
            end;                                                        14750000
         end;                                                           14755000
      enable;                                                           14760000
      end                                                               14765000
   else                                                                 14770000
      level:=intdisabled;                                               14775000
   end;  <<sendsoftint>>                                                14780000
                                                                        14785000
                                                                        14790000
<<initialize>>                                                          14795000
if (flags > 1) or (msglen > maxmsglen) or not (0 <= type <= 1) then     14800000
   suddendeath(uglypseudoint);                                          14805000
if pin = 0 then pin := (curprc)/pcbsize;                       <<06650>>14810000
pcbpt:=pin*pcbsize;                                                     14815000
pdisable;                                                               14820000
                                                                        14825000
<<process soft interrupt>>                                              14830000
if spcbpsim > softkillvalue then                                        14835000
   sendsoftint                                                          14840000
else                                                                    14845000
   begin  <<dying process, reject the interrupt>>                       14850000
   level:=processdead;                                                  14855000
   cc:=ccl;                                                             14860000
   end;                                                                 14865000
penable;                                                                14870000
                                                                        14875000
<<emit mmstat event>>                                                   14880000
if globaltraceflag then                                                 14885000
   begin  <<monitoring is enabled>>                                     14890000
   tpin:=pin; ttype:=type; tsubtype:=subtype; tlevel:=level;            14895000
   mmstat'(mmcause,tmisc,msg0,msg1,0,0,0);                     <<06948>>14900000
   end;                                                                 14905000
                                                                        14910000
<<return to the caller>>                                                14915000
tos:=return6+msglen;                                                    14920000
asmb(xeq);                                                              14925000
end;  <<causesoftint>>                                                  14930000
$page "SOFTWARE INTERRUPTS.  CHANGEINTSTATE PROCEDURE."                 14935000
logical procedure changeintstate(newstate);                    <<03041>>14940000
value newstate;                                                         14945000
                                                                        14950000
<<function                                                              14955000
  enables/disables user soft interrupts against the process.>>          14960000
                                                                        14965000
<<input>>                                                               14970000
  logical                                                               14975000
    newstate;            <<(15:1):  0 - disable the interrupt           14980000
                                    1 - enable user interrupts          14985000
                           (0:15):  ignored.>>                          14990000
<<output                                                                14995000
    changeintstate         old value of the user interrupt state.       15000000
    pregister.(0:1)        set to one if newstate = true and user       15005000
    at caller's q-2.       soft interrupt is pending.  this causes      15010000
                           a bounds violation to inin when the          15015000
                           calling procedure exits.                     15020000
                                                                        15025000
  note: this procedure assumes that the user's stack marker is at       15030000
        q-0 of the calling procedure.  if this is not so, then          15035000
        an extra call to pseudoint (via inin bounds violation) will     15040000
        result.>>                                                       15045000
                                                                        15050000
option privileged,uncallable;                                           15055000
                                                                        15060000
   begin                                                                15065000
   define                                                               15070000
      toldstate   = tmisc.(14:1)#,                                      15075000
      tnewstate   = tmisc.(15:1)#;                                      15080000
   integer                                                              15085000
      oldstate=changeintstate,tmisc:=0,pcbxloc,pcbpt,          <<06686>>15090000
      pxfixedloc;                                              <<06686>>15095000
                                                                        15100000
   <<initialize>>                                                       15105000
   pxfixed;                                                             15110000
   pcbpt := (curprc);                                          <<06650>>15115000
                                                                        15120000
   <<update interrupt state>>                                           15125000
   changeintstate:=spcballowsoft;                                       15130000
   disable; spcballowsoft:=newstate; enable;                            15135000
   pxfxsiflag:=newstate;                                       <<06635>>15140000
                                                                        15145000
   if newstate and log(portstatus(usermsgport)) then                    15150000
      begin  <<got at least one pending interrupt>>                     15155000
      disable; spcbdelaysoft:=1; enable;                                15160000
      <<cause trap to inin on exit to user>>                   <<06635>>15165000
      qarray(-deltaq-2).(0:1):=1;                              <<06635>>15170000
      end;                                                              15175000
                                                                        15180000
   if globaltraceflag then                                              15185000
      begin  <<monitoring is on>>                                       15190000
      tnewstate:=newstate; toldstate:=oldstate;                         15195000
      mmstat'(mmchangestate,tmisc,qarray(-deltaq-2),           <<06948>>15200000
              qarray(-deltaq-1),0,0,0);                        <<06948>>15205000
      end;                                                              15210000
   end;  <<changeintstate>>                                             15215000
$page "DATA STRUCTURE INDEPENDENT INFORMATION PROCEDURES"      <<03041>>15220000
                                                               <<03041>>15225000
logical procedure stackcheck(dstnumber);                       <<03041>>15230000
value dstnumber;                                               <<03041>>15235000
integer dstnumber;                                             <<03041>>15240000
option privileged,uncallable;                                  <<03041>>15245000
                                                               <<03041>>15250000
comment                                                        <<03041>>15255000
                                                               <<03041>>15260000
returns true is specified data seg is a stack else false       <<03041>>15265000
                                                               <<03041>>15270000
;                                                              <<03041>>15275000
                                                               <<03041>>15280000
begin                                                          <<03041>>15285000
stackcheck:=dst(dstnumber&lsl(2)+1).stkflag;                   <<03041>>15290000
end <<stackcheck>>;                                            <<03041>>15295000
                                                               <<01644>>15300000
logical procedure checkalive(pin);                             <<01644>>15305000
value pin;                                                     <<01644>>15310000
integer pin;                                                   <<01644>>15315000
option privileged,uncallable;                                  <<01644>>15320000
                                                               <<01644>>15325000
comment                                                        <<01644>>15330000
                                                               <<01644>>15335000
returns false if pin with pcb index pcbpt is unassigned else tr<<01644>>15340000
                                                               <<01644>>15345000
;                                                              <<01644>>15350000
                                                               <<01644>>15355000
begin                                                          <<01644>>15360000
if pcb(pin*pcbsize+pqptrwordnum)=-1 then checkalive:=false     <<01644>>15365000
else checkalive:=true;                                         <<01644>>15370000
end <<checkalive>> ;                                           <<01644>>15375000
                                                               <<01644>>15380000
procedure lockseg'(obj,blockedlock);                           <<06660>>15385000
value obj,blockedlock;                                         <<06660>>15390000
double  obj;                                                   <<06660>>15395000
logical blockedlock;                                                    15400000
option privileged,uncallable;                                           15405000
                                                                        15410000
comment                                                                 15415000
                                                                        15420000
lockseg' is called to lock a segment in main memory on behalf           15425000
of the calling process. when lockseg' returns to the caller,            15430000
the segment is in main memory and cannot be released until the          15435000
lock count falls to zero.  the segment may be moved about in            15440000
main memory though, provided it has not been frozen.  the blocked       15445000
lock parameter indicates whether the caller intends to freeze           15450000
the segment down for an extended period after locking it. if true,      15455000
lockseg' will not return until the segment has migrated to a            15460000
boundary. if false, lockseg' returns as soon as the seg is              15465000
made present.                                                           15470000
                                                                        15475000
entry freezeseg' is called to freeze a segment in main memory on behalf 15480000
of the calling process.  once the segment is present, it will           15485000
not be released from main memory or moved within main memory            15490000
until the freezecount in the segment's region header falls to           15495000
zero. the blockedlock flag is ignored for freezeseg' calls.             15500000
                                                                        15505000
only segments can be locked in memory, not mapped domains.     <<06212>>15510000
;                                                                       15515000
                                                                        15520000
begin                                                                   15525000
integer descstinx,pcbpt;                                       <<06650>>15530000
logical freeze;                                                         15535000
logical flags := 0;                                            <<06393>>15540000
logical array objident(*) = obj;                               <<06660>>15545000
double savedb;                                                 <<06393>>15550000
entry freezeseg';                                                       15555000
                                                                        15560000
freeze:=false;                                                          15565000
go over;                                                                15570000
                                                                        15575000
freezeseg':                                                             15580000
freeze:=true;                                                           15585000
                                                                        15590000
over:                                                                   15595000
                                                                        15600000
disable;                                                                15605000
x := descstinx := convsegidtostinx(obj);                       <<06660>>15610000
if not logical(dst(x:=x+1)).segresidentflag then                        15615000
   begin  <<not resident>>                                              15620000
   tos:=%1000d;                                                         15625000
   asmb(xchd);                                                          15630000
   savedb := tos;                                              <<06393>>15635000
   pcbpt := curprc;                                            <<06650>>15640000
   tos := sllptr;                                              <<06650>>15645000
   tos := obj;                                                 <<06660>>15650000
   flags := 0;                                                 <<06393>>15655000
   flags.setmemreqptrflag := 1;                                <<06393>>15660000
   if freeze then flags.setfzflag := 1                         <<06393>>15665000
   else if blockedlock then                                    <<06393>>15670000
      flags.setblklkflag := 1 else flags.setlockflag := 1;     <<06393>>15675000
   tos := flags;                                               <<06393>>15680000
   addtolocality(*,*,*);                                                15685000
   tos := savedb;                                              <<06393>>15690000
   asmb(xchd);                                                          15695000
   ddel;                                                       <<06393>>15700000
   wait(memorywaitcode,memtrap);                                        15705000
   x := descstinx := convsegidtostinx(obj);                    <<06660>>15710000
   end;                                                                 15715000
if dst(descstinx).absentflag=0 then cc:=cce else cc:=ccl;               15720000
end  <<lockseg'>>;                                                      15725000
                                                                        15730000
                                                                        15735000
$title "UNCALLABLE UTILITIES : UNLOCKSEG'"                              15740000
                                                                        15745000
procedure unlockseg'(obj);                                     <<06660>>15750000
value obj;                                                     <<06660>>15755000
double  obj;                                                   <<06660>>15760000
option privileged,uncallable;                                           15765000
                                                                        15770000
begin                                                                   15775000
logical unfreeze;                                                       15780000
logical array objident(*)=obj;                                 <<06660>>15785000
integer count,                                                          15790000
        type := 0,      << for mmstat' >>                      <<*7564>>15795000
        descstinx;                                                      15800000
entry unfreezeseg';                                                     15805000
                                                                        15810000
type.(12:4) := 5;   <<unlock type>>                            <<01571>>15815000
unfreeze:=false;                                                        15820000
go over;                                                                15825000
                                                                        15830000
unfreezeseg':                                                  <<*7564>>15835000
type.(12:4) := 4;                                              <<*7564>>15840000
unfreeze:=true;                                                         15845000
                                                                        15850000
over:                                                                   15855000
disable;                                                                15860000
descstinx:=convsegidtostinx(obj);                              <<06660>>15865000
if dst(descstinx) < 0 then suddendeath(606);<<absent>>         <<01644>>15870000
if dst(x:=descstinx+1).segresidentflag<>1 then                          15875000
   begin <<seg not core resident>>                                      15880000
   tos:=dst(x:=x+1);   <<segdescbank>>                                  15885000
   tos:=dst(x:=x+1);                                                    15890000
   tos:=tos+rbtolkfzcntdisp;                                            15895000
   asmb(lsea);                                                          15900000
   count:=tos;                                                          15905000
                                                               <<*7564>>15910000
   if unfreeze and count.fzcntfield <= 0  or                   <<*7564>>15915000
      not unfreeze and count.lkcntfield <= 0 then              <<*7564>>15920000
      suddendeath(606);                                        <<*7564>>15925000
                                                               <<*7564>>15930000
   if unfreeze then count.fzcntfield:=count.fzcntfield-1                15935000
   else count.lkcntfield:=count.lkcntfield-1;                           15940000
   tos:=count;                                                          15945000
   asmb(ssea);                                                          15950000
   if count.fzcntfield=0 and unfreeze or count.lkcntfield=0 and not     15955000
   unfreeze then                                                        15960000
      begin <<seg is completely unlocked or unfrozen>>                  15965000
      tos:=tos+lkfzcnttorasdisp;                                        15970000
      asmb(lsea);                                                       15975000
      if unfreeze then tos.regfzflag:=0 else tos.reglkdflag:=0;         15980000
      if = then suddendeath(606);                              <<01644>>15985000
      asmb(ssea);                                                       15990000
      end;                                                              15995000
   end;                                                                 16000000
mmstat'(mmstatspecreq,objident(objiddescfield),                <<06948>>16005000
       objident(objidnumfield),type,count,0,0);                <<06948>>16010000
end  <<unfreeze>>;                                                      16015000
                                                                        16020000
$title "UNCALLABLE UTILITIES : LOCKSEG"                                 16025000
                                                                        16030000
procedure lockseg(entrynumber,flags,pinx);                              16035000
value entrynumber,flags,pinx;                                           16040000
integer entrynumber,pinx;                                               16045000
logical flags;                                                          16050000
option privileged,uncallable;                                           16055000
                                                                        16060000
comment                                                                 16065000
                                                                        16070000
emulates prev iofreeze,iounfreeze,lockseg,freeze. weed out calls to it. 16075000
                                                                        16080000
;                                                                       16085000
begin                                                                   16090000
logical lockcall:=false;                                                16095000
double  obj;                                                   <<06660>>16100000
logical array objident(*)=obj;                                 <<06660>>16105000
integer segtype;                                               <<06660>>16110000
logical freezecall,                                                     16115000
        iofzcall,                                                       16120000
        iounfzcall,                                                     16125000
        unfreezecall,                                                   16130000
        unlockcall;                                                     16135000
logical array segid(*)=obj;                                    <<06660>>16140000
entry freeze,unfreeze,unlockseg,iofreeze,iounfreeze;                    16145000
iofzcall:=iounfzcall:=unlockcall:=unfreezecall:=freezecall:=false;      16150000
lockcall:=true;                                                         16155000
go over;                                                                16160000
freeze:                                                                 16165000
freezecall:=true;                                                       16170000
iofzcall:=iounfzcall:=lockcall:=unfreezecall:=unlockcall:=false;        16175000
go over;                                                                16180000
unfreeze:                                                               16185000
unfreezecall:=true;                                                     16190000
iofzcall:=iounfzcall:=lockcall:=unlockcall:=freezecall:=false;          16195000
go over;                                                                16200000
unlockseg:                                                              16205000
unlockcall:=true;                                                       16210000
iofzcall:=iounfzcall:=lockcall:=unfreezecall:=freezecall:=false;        16215000
go over;                                                                16220000
iofreeze:                                                               16225000
iofzcall:=true;                                                         16230000
unlockcall:=iounfzcall:=lockcall:=unfreezecall:=freezecall:=false;      16235000
go over;                                                                16240000
iounfreeze:                                                             16245000
iofzcall:=unlockcall:=lockcall:=unfreezecall:=freezecall:=false;        16250000
iounfzcall:=true;                                                       16255000
go over;                                                                16260000
over:                                                                   16265000
if curprc = 0  and not iofzcall and not iounfzcall             <<06650>>16270000
then suddendeath(607);                                         <<01644>>16275000
if pinx = 0 then pinx:=curprc;                                 <<06650>>16280000
if flags then obj:=buildsegid(0,entrynumber,pinx/pcbsize)      <<06660>>16285000
else obj:=mappedcsttophycst(logical(entrynumber)               <<06660>>16290000
                                 ,pinx);                       <<06944>>16295000
if freezecall then                                                      16300000
   begin                                                                16305000
   freezeseg'(obj,0);                                          <<06660>>16310000
   cc:=cce;                                                             16315000
   end                                                                  16320000
else if unfreezecall then                                               16325000
   begin                                                                16330000
   unfreezeseg'(obj);                                          <<06660>>16335000
   cc:=cce;                                                             16340000
   end                                                                  16345000
else if unlockcall then                                                 16350000
   begin                                                                16355000
   unlockseg'(obj);                                            <<06660>>16360000
   cc:=cce;                                                             16365000
   end                                                                  16370000
else if lockcall then                                                   16375000
   begin                                                                16380000
   lockseg'(obj,0);       <<for now all unblocked>>            <<06660>>16385000
   if = then cc:=cce else cc:=ccl;                                      16390000
   end                                                                  16395000
   comment                                                     <<06212>>16400000
                                                               <<06212>>16405000
   here's some old code                                        <<06212>>16410000
     if not flags.(13:1) and not flags.(14:1) then             <<06212>>16415000
      begin                                                             16420000
      lockseg'(obj,-1)        default blocked lock             <<06660>>16425000
      cc:=cce                                                  <<06212>>16430000
      end                                                               16435000
   else cc:=ccl can't specify location                         <<06212>>16440000
                                                               <<06212>>16445000
   ;                                                           <<06212>>16450000
                                                               <<06212>>16455000
else if iofzcall then                                                   16460000
   begin                                                                16465000
   iofreeze'(obj);                                             <<06660>>16470000
   if < then cc:=ccl else if = then cc:=cce else if > then cc:=ccg;     16475000
   end                                                                  16480000
else if iounfzcall then                                                 16485000
   begin                                                                16490000
   iounfreeze'(obj);                                           <<06660>>16495000
   if < then cc:=ccl else if = then cc:=cce else if > then cc:=ccg;     16500000
   end;                                                        <<01644>>16505000
end <<lockseg>>;                                                        16510000
                                                                        16515000
$title "UNCALLABLE UTILITIES : UPDATE DISC COPY"                        16520000
procedure updatedisccopy(dstentry);                                     16525000
value dstentry;                                                         16530000
integer dstentry;                                                       16535000
option privileged,uncallable;                                           16540000
                                                                        16545000
comment                                                                 16550000
                                                                        16555000
updatedisccopy issues a blocked attachio on behalf of the process       16560000
to write the contents of the data segment to the copy of the segment    16565000
in virtual memory.  if the disc copy is                                 16570000
already valid, control returns immediately to the calling process.      16575000
                                                                        16580000
;                                                                       16585000
                                                                        16590000
begin                                                                   16595000
define rtype=(14:2)#;                                                   16600000
entry writedseg,writedseg'serial;                              <<*7823>>16605000
integer hoda,                                                           16610000
        ldevnum,                                                        16615000
        descstinx,                                                      16620000
        cnt,                                                            16625000
        loda,                                                  <<*7823>>16630000
        serial'write'queue := %2001;                           <<*7823>>16635000
                                                               <<*7823>>16640000
logical                                                        <<*7823>>16645000
   use'serial'write'queue;                                     <<*7823>>16650000
                                                               <<*7823>>16655000
writedseg:      <<renamed to updatedisccopy>>                           16660000
                                                               <<*7823>>16665000
if (use'serial'write'queue := false) then                      <<*7823>>16670000
   begin                                                       <<*7823>>16675000
                                                               <<*7823>>16680000
writedseg'serial:                                              <<*7823>>16685000
                                                               <<*7823>>16690000
   use'serial'write'queue := true;                             <<*7823>>16695000
   end;                                                        <<*7823>>16700000
                                                               <<*7823>>16705000
descstinx:=dstentry&lsl(2);                                             16710000
disable;  <<while figuring out the disc address>>                       16715000
if not logical(dst(x:=descstinx+1)).disccopyvalidflag then              16720000
   begin                                                                16725000
   cnt:=(dst(descstinx).datasizefield)&lsl(2);                          16730000
   tos:=dst(x:=descstinx+2);                                            16735000
   tos:=dst(x:=x+1);                                                    16740000
   if not logical(dst(descstinx)).absentflag                            16745000
   or logical(dst(descstinx+1)).imiflag                                 16750000
   or logical(dst(descstinx+1)).rocflag then                            16755000
      begin <<disc address is in memory header>>                        16760000
      tos:=tos+rbtohodadisp;                                            16765000
      asmb(ldea);                                                       16770000
      end;                                                              16775000
   enable;                                                              16780000
   loda:=tos;                                                           16785000
   hoda:=s0.(8:8);                                                      16790000
   ldevnum:=tos.(0:8);  <<ldevn>>                                       16795000
                                                               <<*7823>>16800000
   if use'serial'write'queue then                              <<*7823>>16805000
      tos := attachio(ldevnum,0,dstentry,0,writereq,cnt,hoda,  <<*7823>>16810000
                      loda,serial'write'queue)                 <<*7823>>16815000
   else                                                        <<*7823>>16820000
      tos := p'attachio(ldevnum,0,dstentry,0,writereq,cnt,hoda,<<*7823>>16825000
                        loda,1);                               <<*7823>>16830000
   if s1.(13:3) <> 1 then suddendeath(654);                    <<01644>>16835000
   end;                                                                 16840000
end  <<updatedisccopy>>;                                                16845000
$page "PROCESS CONTROL UNCALLABLE INTRINSICS"                           16850000
                                                                        16855000
                                                                        16860000
                                                                        16865000
procedure abortprocess(procsysdbinx,abortcode);                         16870000
value procsysdbinx,abortcode;                                           16875000
integer procsysdbinx,abortcode;                                         16880000
option privileged,uncallable;                                           16885000
                                                                        16890000
begin                                                                   16895000
suddendeath(608); <<not yet supported>>                        <<01644>>16900000
end  <<abortproc>>;                                                     16905000
$page "PROCESS CONTROL UNCALLABLE INTRINSICS : QUEUEPROC"               16910000
procedure queueproc(procsysdbinx,queuename,location);                   16915000
value procsysdbinx,queuename,location;                                  16920000
integer procsysdbinx,queuename,location;                                16925000
option privileged,uncallable;                                           16930000
                                                                        16935000
comment                                                                 16940000
                                                                        16945000
queueproc removes a process from its current queue                      16950000
and merges it into the queue specified by queuename.                    16955000
location indicates whether the process is to be queued                  16960000
at the front or end of its urgency class subqueue for                   16965000
the dispq.                                                              16970000
                                                                        16975000
the parameters follow the following conventions:                        16980000
                                                                        16985000
procssysdbinx is the sysdb index of the process' pcb entry.             16990000
                                                                        16995000
queuename = 1 ==> queue into dispatching queue,                         17000000
          = 0 ==> don't put on any queue                                17005000
                                                                        17010000
location = 1 ==> queue at front of class subqueue                       17015000
         = 0 ==> queue at end of class subqueue.                        17020000
                                                                        17025000
db must be set at sysdb when entering the procedure.                    17030000
                                                                        17035000
;                                                                       17040000
                                                                        17045000
                                                                        17050000
begin                                                                   17055000
                                                                        17060000
integer procinx:=0,                                                     17065000
        pcbpt,                                                 <<06650>>17070000
        prev;                                                           17075000
logical procpri,                                                        17080000
        dispq:=false,                                                   17085000
        notqueued:=false;                                               17090000
                                                                        17095000
<< check range of pcb >>                                                17100000
                                                                        17105000
tos := pcbpt := procsysdbinx;                                  <<06650>>17110000
if <= or ls0 > logical(pcb(0)*pcb(1)) then suddendeath(608);   <<01644>>17115000
asmb(del);                                                              17120000
                                                                        17125000
<<find out if process is already on a queue>>                           17130000
                                                                        17135000
disable;                                                                17140000
queueinginfo.dispqflag := 0;                                   <<06650>>17145000
if <> then dispq:=true else notqueued:=true;                            17150000
                                                                        17155000
if dispq then                                                           17160000
   begin  <<proc is on a queue, so take it off>>                        17165000
   tos := pqptr;                                               <<06650>>17170000
   if = then                                                            17175000
      begin  <<first proc in q>>                                        17180000
      tos := nqptr;                                            <<06650>>17185000
      if = then                                                         17190000
         begin  <<only proc in q>>                                      17195000
         dispqhead:=tos;                                                17200000
         dispqtail:=tos;                                                17205000
         end                                                            17210000
      else                                                              17215000
         begin  <<somebody behind him/her>>                             17220000
         nqptr := 0;                                           <<06650>>17225000
         pcbpt := tos;                                         <<06650>>17230000
         pqptr := tos; << zero out nexts pqp >>                <<06650>>17235000
         dispqhead := pcbpt;                                   <<06650>>17240000
         end;                                                           17245000
      end                                                               17250000
   else                                                                 17255000
      begin  <<not first in q>>                                         17260000
      pqptr := 0;                                              <<06650>>17265000
      tos := nqptr;                                            <<06650>>17270000
      nqptr := 0;                                              <<06650>>17275000
      asmb(dup);                                                        17280000
      if = then                                                         17285000
         begin <<last proc in queue>>                                   17290000
         asmb(del);                                                     17295000
         pcbpt := s1;                                          <<06650>>17300000
         nqptr := tos; << zero out previous nqp >>             <<06650>>17305000
         dispqtail := pcbpt;                                   <<06650>>17310000
         end                                                            17315000
      else                                                              17320000
         begin <<proc in middle of queue>>                              17325000
         pcbpt := tos;                                         <<06650>>17330000
         asmb(xch);                                                     17335000
         asmb(dup);                                                     17340000
         pqptr := tos;                                         <<06650>>17345000
         pcbpt := tos;                                         <<06650>>17350000
         nqptr := tos;                                         <<06650>>17355000
         end;                                                           17360000
      end;                                                              17365000
   end;                                                                 17370000
                                                                        17375000
pcbpt := procsysdbinx;                                         <<06650>>17380000
if queuename <> 0  then                                                 17385000
   begin <<merge into dispq>>                                           17390000
   queueinginfo.dispqflag := 1;                                <<06650>>17395000
   procpri := queueinginfo.prifield;                           <<06650>>17400000
   pcbpt := dispqhead;                                         <<06650>>17405000
   if = then dispqhead := dispqtail := procsysdbinx else       <<06650>>17410000
      begin  <<q is non-empty>>                                         17415000
      if logical(location) then                                         17420000
         begin <<queue in front of urgency subq>>                       17425000
         while pcbpt <> 0 do                                   <<06650>>17430000
            begin                                                       17435000
            if queueinginfo.prifield < procpri then            <<06650>>17440000
               pcbpt := nqptr else                             <<06650>>17445000
               begin <<insert in front of this pcb>>                    17450000
               procinx := pcbpt;                               <<06650>>17455000
               pcbpt := 0; << to terminate while loop >>       <<06650>>17460000
               end;                                                     17465000
            end;                                                        17470000
         end                                                            17475000
      else                                                              17480000
         begin  <<at end of class subq>>                                17485000
         while pcbpt <> 0 do                                   <<06650>>17490000
            begin                                                       17495000
            if queueinginfo.prifield <= procpri then           <<06650>>17500000
               pcbpt := nqptr else                             <<06650>>17505000
               begin <<insert in front of this pcb>>                    17510000
               procinx := pcbpt;                               <<06650>>17515000
               pcbpt := 0; << to terminate while loop >>       <<06650>>17520000
               end;                                                     17525000
            end;                                                        17530000
         end;                                                           17535000
      pcbpt := procinx;                                        <<06650>>17540000
      if = then                                                         17545000
         begin  <<belongs at end of queue>>                             17550000
         tos:=dispqtail;                                                17555000
         dispqtail := procsysdbinx;                            <<06650>>17560000
         pcbpt := procsysdbinx;                                <<06650>>17565000
         pqptr := s0;                                          <<06650>>17570000
         x := pcbpt;                                           <<06650>>17575000
         asmb(xax);                                                     17580000
         pcbpt := x;                                           <<06650>>17585000
         nqptr := tos;                                         <<06650>>17590000
         end                                                            17595000
      else                                                              17600000
         begin <<belongs in front of that pcb>>                         17605000
         prev := pqptr;                                        <<06650>>17610000
         pqptr := procsysdbinx;                                <<06650>>17615000
         pcbpt := prev;                                        <<06650>>17620000
         if = then                                                      17625000
            begin  <<goes at front of q>>                               17630000
            pcbpt := dispqhead := procsysdbinx;                <<06650>>17635000
            nqptr := procinx;                                  <<06650>>17640000
            end                                                         17645000
         else                                                           17650000
            begin  <<merge into middle>>                                17655000
            nqptr := procsysdbinx;                             <<06650>>17660000
            pcbpt := procsysdbinx;                             <<06650>>17665000
            pqptr := prev;                                     <<06650>>17670000
            nqptr := procinx;                                  <<06650>>17675000
            end;                                                        17680000
         end;                                                           17685000
      end;                                                              17690000
   end;                                                                 17695000
end  <<procedure queueproc>>;                                           17700000
$page "PROCESS CONTROL UNCALLABLE INTRINSICS : RESETDISPQ"              17705000
procedure resetdispq;                                                   17710000
option privileged,uncallable;                                           17715000
                                                                        17720000
comment                                                                 17725000
                                                                        17730000
resetdispq is called by the tune command executor to place all          17735000
processes at the base of their scheduling classes in the dispq.         17740000
                                                                        17745000
this initialization is necessary in order to respond quickly to         17750000
the newly desired scheduling conditions, and to keep from stranding     17755000
processes which may have been filtered beyond the new limits.           17760000
                                                                        17765000
in order not to have to hold off interrupts too long, the dispq         17770000
is scanned until a process is found that is not at the appropriate      17775000
scheduling base.  this process is queued to the proper place, then      17780000
interrupts are enabled, and the queue scan starts over.  the system     17785000
is pdisabled throughout.                                                17790000
                                                                        17795000
;                                                                       17800000
                                                                        17805000
begin                                                                   17810000
                                                                        17815000
double savedb;                                                          17820000
                                                                        17825000
logical cbase,                                                          17830000
        dbase,                                                          17835000
        ebase;                                                          17840000
integer pcbpt;                                                 <<06650>>17845000
                                                                        17850000
pdisable;                                                               17855000
                                                                        17860000
<<put db at sysdb>>                                                     17865000
                                                                        17870000
tos:=%1000d;                                                            17875000
asmb(xchd);                                                             17880000
savedb:=tos;                                                            17885000
                                                                        17890000
<<get the new scheduling bases from the ics>>                           17895000
                                                                        17900000
cbase:=ics(-ics'cschedbasecell);                                        17905000
dbase:=ics(-ics'dschedbasecell);                                        17910000
ebase:=ics(-ics'eschedbasecell);                                        17915000
                                                                        17920000
<<move all the processes on dispq to their scheduling bases>>           17925000
                                                                        17930000
disable;                                                                17935000
pcbpt := dispqhead;                                            <<06650>>17940000
while <> do                                                             17945000
   begin <<locate first process at wrong place and move it>>            17950000
   if queueinginfo.lschedflag then pcbpt:=nqptr                <<06650>>17955000
   else if queueinginfo.cschedflag=1 and                       <<06650>>17960000
           queueinginfo.prifield=cbase                         <<06650>>17965000
   then pcbpt := nqptr                                         <<06650>>17970000
   else if queueinginfo.dschedflag=1 and                       <<06650>>17975000
           queueinginfo.prifield=dbase                         <<06650>>17980000
   then pcbpt := nqptr                                         <<06650>>17985000
   else if queueinginfo.eschedflag=1 and                       <<06650>>17990000
           queueinginfo.prifield=ebase                         <<06650>>17995000
   then pcbpt := nqptr else                                    <<06650>>18000000
      begin  <<this guy is out of order>>                               18005000
      if queueinginfo.cschedflag then                          <<06650>>18010000
         queueinginfo.prifield:=cbase else                     <<06650>>18015000
      if queueinginfo.dschedflag then                          <<06650>>18020000
         queueinginfo.prifield:=dbase else                     <<06650>>18025000
      if queueinginfo.eschedflag then                          <<06650>>18030000
         queueinginfo.prifield:=ebase;                         <<06650>>18035000
      queueproc(pcbpt,dispatchingq,endofclass);                <<06650>>18040000
      enable;                                                           18045000
      disable;                                                          18050000
      pcbpt := dispqhead; << start scan over >>                <<06650>>18055000
      end;                                                              18060000
   end;                                                                 18065000
                                                                        18070000
<<put db back to the right place>>                                      18075000
                                                                        18080000
tos:=savedb;                                                            18085000
asmb(xchd);                                                             18090000
                                                                        18095000
penable;                                                                18100000
                                                                        18105000
end  <<resetdispq>>;                                                    18110000
                                                                        18115000
$page "PROCESS CONTROL UNCALLABLE INTRINSICS : WAIT"                    18120000
procedure wait(eventmask,specialinfo);                                  18125000
value eventmask,specialinfo;                                            18130000
integer eventmask;                                                      18135000
logical specialinfo;                                                    18140000
option privileged,uncallable;                                           18145000
                                                                        18150000
comment                                                                 18155000
                                                                        18160000
wait is called by the system whenever the calling process must          18165000
block until an event occurs. the eventmask parameter specifies          18170000
the event types which the process wishes to be awakened on. the         18175000
caller may request that control be returned immediately if an           18180000
awake on one of the event types has already occurred by passing the     18185000
eventmask as a negative eventmask.                                      18190000
                                                                        18195000
the specialinfo parameter passes along information on the process'      18200000
cause of blocking, estimates on how long the process might be           18205000
expected to stay blocked, estimates on whether the locality             18210000
might be expected to remain about the same or undergo a radical         18215000
transition when the process continues.                                  18220000
                                                               <<03041>>18225000
specialinfo.(3:1) <= 1 enables either soft interrupts or the   <<03041>>18230000
specified wait events to wake up the process.  wait returns a  <<03041>>18235000
cce condition code if awakened by a wait event, a ccg is       <<03041>>18240000
returned for the soft interrupt case.                          <<03041>>18245000
                                                                        18250000
;                                                                       18255000
                                                                        18260000
begin                                                                   18265000
define                                                         <<03041>>18270000
   allowsoftint     = specialinfo.(3:1)#;                      <<03041>>18275000
double savedb;                                                          18280000
integer savex;                                                          18285000
integer pcbxloc,                                               <<06686>>18290000
        pxfixedloc;                                            <<06686>>18295000
integer pcbpt,procinx;                                         <<06650>>18300000
                                                                        18305000
turnofftraps;                                                  <<01860>>18310000
cc:=cce;                                                       <<03041>>18315000
pcbpt := curprc;                                               <<06650>>18320000
procinx := pcbpt;                                              <<06650>>18325000
                                                               <<01860>>18330000
disable;                                                                18335000
if allowsoftint then                                           <<03041>>18340000
   begin  <<check if a soft int has occurred>>                 <<03041>>18345000
   pxfixed;                                                    <<03041>>18350000
   if log(spcbdelaysoft) or log(pxfxcyflag) then               <<06650>>18355000
      begin  <<soft int has already happened>>                 <<03041>>18360000
      cc:=ccg;                                                 <<03041>>18365000
      return;                                                  <<03041>>18370000
      end;                                                     <<03041>>18375000
   spcbwakesoft := 1;                                          <<06650>>18380000
   end;                                                        <<03041>>18385000
                                                                        18390000
tos:=%1000d;                                                            18395000
asmb(xchd);                                                             18400000
savedb:=tos;                                                            18405000
                                                                        18410000
disable;                                                                18415000
if eventmask < 0 then                                                   18420000
   begin <<caller wants wws checked>>                                   18425000
   eventmask:=-eventmask;                                               18430000
   if specialinfo.(2:1) then                                            18435000
      begin  <<new version of wait>>                                    18440000
      if eventflags land log(eventmask&csl(4)) <> 0 then       <<06650>>18445000
         begin  <<an event which the process is                         18450000
                  waiting for has already occurred>>                    18455000
         suddendeath(604);                                     <<01644>>18460000
         waittodispmsg.phasetransflag:=0;                               18465000
         waittodispmsg.discwaitflag:=0;                                 18470000
         ics(-ics'pdiscntcell):=0;                                      18475000
         tos:=savedb;                                                   18480000
         asmb(xchd);                                                    18485000
         return;                                                        18490000
         end;                                                           18495000
      end                                                               18500000
   else                                                                 18505000
      begin  <<old version>>                                            18510000
      if eventflags.wws <> 0                                   <<06650>>18515000
       then                                                    <<02826>>18520000
         begin   <<event already occurred-return to process>>           18525000
         waittodispmsg.phasetransflag:=0;                               18530000
         eventflags := 0; << clear wake semaphores >>          <<06650>>18535000
         waittodispmsg.discwaitflag:=0;                                 18540000
         tos:=savedb;                                                   18545000
         asmb(xchd);                                                    18550000
         ics(-ics'pdiscntcell):=0;                                      18555000
         return;                                                        18560000
         end;                                                           18565000
      end;                                                              18570000
   end;                                                                 18575000
if eventmask = 0 then                                                   18580000
   begin <<better be an impede or shutdown>>                            18585000
   specialinfo.imptrapflag:=0;                                          18590000
   if <> then                                                           18595000
      begin                                                             18600000
      eventmask:=impwaitcode;                                           18605000
      if gclassenabledmask.class0 then                                  18610000
         begin  <<measure impede process stop event>>                   18615000
         tos:=measstatxdsbank;                                          18620000
         tos:=measstatxdsbase;                                          18625000
         tos:=tos+c0sub0'segreloff+c'stopimpede;               <<ray.v>>18630000
         asmb(lsea);                                                    18635000
         tos:=tos+1;                                                    18640000
         asmb(ssea;ddel);                                               18645000
         end;                                                           18650000
      if gclassenabledmask.class15 then                        <<01812>>18655000
         begin <<measure stop for impede>>                     <<01812>>18660000
         tos:=measprocxdsbank;                                 <<01812>>18665000
         tos:=measprocxdsbase;                                 <<01812>>18670000
         tos := tos + curprc/pcbsize *                         <<06686>>18675000
              class15'sub0size+cp'stopimpede;                  <<01812>>18680000
         asmb(lsea);                                           <<01812>>18685000
         tos:=tos+1;                                           <<01812>>18690000
         asmb(ssea;ddel);                                      <<01812>>18695000
         end;                                                  <<01812>>18700000
      <<stuff away reason stopped in pcbx of impeded process>> <<01812>>18705000
      <<done unconditionally for history for meas interface>>  <<01812>>18710000
      tos:=ics(-ics'stkbankcell);                              <<01812>>18715000
      tos:=ics(-ics'stkbasecell);                              <<01812>>18720000
      tos:=tos+sbtomeasstopreason;                             <<01812>>18725000
      tos:=stopimpede;                                         <<01812>>18730000
      asmb(ssea;ddel);                                         <<01812>>18735000
      end                                                      <<01799>>18740000
   else queueproc(pcbpt  ,noqueue,0);  << toss for ever >>     <<06650>>18745000
   end;                                                                 18750000
eventflags := 0;                                               <<06650>>18755000
wakemask := wakemask lor (logical(eventmask) & csl(4));        <<06945>>18760000
if wakemask.fathersonwakeflags <> 0                            <<06650>>18765000
then waittodispmsg.transcompflag:=1;                                    18770000
waittodispmsg:=waittodispmsg lor specialinfo;  <<pass along info>>      18775000
ics(-ics'pdiscntcell):=0;                                               18780000
tos:=savedb;                                                            18785000
asmb(xchd);                                                             18790000
asmb (disp);                                                            18795000
if integer(procstate).stovflag = 1                             <<06650>>18800000
   and not resabortinfo.stovabortflag                          <<06650>>18805000
                                                               <<06650>>18810000
and not stkinfo.insystemflag                                   <<06650>>18815000
and not resabortinfo.critflag                                  <<06650>>18820000
and not resabortinfo.hassirflag then                           <<06650>>18825000
   begin <<was disabled or pdisabled when overflowed, not in system>>   18830000
      resabortinfo.stovabortflag := 1;                         <<06650>>18835000
                                                               <<06650>>18840000
      abort([8/1,8/4],0,0);                                    <<04486>>18845000
   end;                                                                 18850000
                                                               <<03041>>18855000
if allowsoftint then                                           <<03041>>18860000
   begin  <<check if were awakened by a soft interrupt>>       <<03041>>18865000
   spcbwakesoft := 0;                                          <<06650>>18870000
   if = then cc:=ccg;  <<were awakened by a soft interrupt>>   <<03041>>18875000
   end;                                                        <<03041>>18880000
end  <<procedure wait>>;                                                18885000
                                                                        18890000
$page "PROCESS CONTROL UNCALLABLE INTRINSICS : AWAKE"                   18895000
procedure awake (pcbpt,wakecode,waitflags);                             18900000
value pcbpt,wakecode,waitflags;                                         18905000
integer pcbpt,waitflags;                                                18910000
logical wakecode;                                                       18915000
option privileged,uncallable;                                           18920000
                                                                        18925000
comment                                                                 18930000
                                                                        18935000
awake is called to awaken a process on a given event type.              18940000
the caller may optionally request that he be waited upon                18945000
the successful activation of the specified process. the                 18950000
awakened process is notified of the attempted awake through             18955000
the wake up semaphores of the pcb.                                      18960000
                                                                        18965000
the condition code is set as follows:                                   18970000
   if the process is already active cc:=ccg.                            18975000
   if the process is waiting but not on the event                       18980000
      type specified cc:=ccl.                                           18985000
   if the process is waiting on the specifdied event                    18990000
      type, cc:=cce.                                                    18995000
;                                                                       19000000
                                                                        19005000
begin                                                                   19010000
                                                                        19015000
integer status=q-1,                                                     19020000
        procinx;                                                        19025000
logical eventmask;                                                      19030000
double savedb;                                                          19035000
                                                                        19040000
turnofftraps;                                                  <<01860>>19045000
                                                               <<01860>>19050000
pdisable;  <<cause we'll put db at sysdb fast>>                         19055000
tos:=%1000d;                                                            19060000
exchdb;                                                                 19065000
savedb:=tos;                                                            19070000
procinx := pcbpt;                                              <<06650>>19075000
eventmask:=wakecode&csl(4);                                             19080000
disable;                                                                19085000
                                                                        19090000
if logical(pcbpt) mod pcbsize <> 0  or  pqptr = -1 or          <<07320>>19095000
   pcbpt = 0 then                                              <<07320>>19100000
    suddendeath(623);   <<invalid or unassigned>>              <<02716>>19105000
if wakecode=memorywaitcode and resabortinfo.sarflag then       <<06650>>19110000
   begin                                                       <<07320>>19115000
   tos := savedb;                                              <<07320>>19120000
   exchdb;                                                     <<07320>>19125000
   penable;                                                    <<07320>>19130000
   return;                                                     <<07320>>19135000
   end;                                                        <<07320>>19140000
                                                               <<07320>>19145000
if wakecode <> memorywaitcode then                             <<02826>>19150000
eventflags := eventflags lor eventmask;                        <<06650>>19155000
if (wakemask land eventmask) = 0 then                          <<06650>>19160000
   begin  <<process isn't waiting for this event>>                      19165000
   if eventmask.criteventfield <> 0 and wakecode <> impwaitcode         19170000
      then suddendeath(610);                                   <<01644>>19175000
   <<awake for a critical event which the                               19180000
     process wasn't expecting>>                                         19185000
   eventflags.wws := 1;                                        <<06650>>19190000
   if wakemask.noncriteventfield = 0 then                      <<06650>>19195000
      begin  <<process is active>>                                      19200000
      tos:=savedb;                                                      19205000
      exchdb;                                                           19210000
      cc:=ccg;                                                          19215000
      tos:=waitflags;                                                   19220000
      if <> then wait(*,noinfo) else penable;                  <<*7564>>19225000
      end                                                               19230000
   else                                                                 19235000
      begin                                                             19240000
      cc:=ccl;                                                          19245000
      tos:=savedb;                                                      19250000
      exchdb;                                                           19255000
      penable;                                                          19260000
      end;                                                              19265000
   end                                                                  19270000
else                                                                    19275000
   begin <<process waiting for this event type>>                        19280000
   cc:=cce;                                                             19285000
   <<set origin of activation>>                                         19290000
   tos:=eventmask.fathersonwakeflags;                                   19295000
   if = then asmb(del) else piinfo.oafield:=tos;               <<06650>>19300000
   <<clear wakemask flags corresponding to event types occurred>>       19305000
   tos := wakemask xor eventmask;                              <<06650>>19310000
   tos := wakemask; asmb(and); wakemask := tos;                <<06650>>19315000
   if eventmask.noncriteventfield <> 0                                  19320000
   then wakemask.noncriteventfield := 0;                       <<06650>>19325000
   if not wakemask.impededwaitflag                             <<06650>>19330000
   and not queueinginfo.dispqflag                              <<06650>>19335000
   then queueproc(pcbpt,dispatchingq,endofclass);              <<06650>>19340000
   if waitflags <> 0 then                                               19345000
      begin << wait caller >>                                           19350000
      tos:=savedb;                                                      19355000
      exchdb;                                                           19360000
      wait(waitflags,noinfo);                                           19365000
      end                                                               19370000
   else                                                                 19375000
      begin                                                             19380000
      enable;                                                           19385000
      disable;                                                          19390000
      if disptoawakemsg.disprunningflag then                            19395000
         begin  <<dispatcher is running>>                               19400000
         if disptoawakemsg.pausedflag then                              19405000
            begin <<dispatcher is paused>>                              19410000
            tos:=savedb;                                                19415000
            exchdb;                                                     19420000
            penable;                                                    19425000
            asmb (disp);                                                19430000
            end                                                         19435000
         else                                                           19440000
            begin                                                       19445000
            x:=procinx;                                                 19450000
            tos := queueinginfo.prifield;                      <<06650>>19455000
            if awaketoschedmsg <= ls0 then asmb(del)                    19460000
            else awaketoschedmsg:=tos;                                  19465000
            tos:=savedb;                                                19470000
            exchdb;                                                     19475000
            penable;                                                    19480000
            end;                                                        19485000
         end                                                            19490000
      else                                                              19495000
                                                               <<02827>>19500000
         <<there is a current process - consider preemption>>  <<02827>>19505000
         <<only if new process is in a more urgent queue or>>  <<02827>>19510000
         <<if dispatcher has specifically enabled preemption>> <<02827>>19515000
         <<then preemption will be based on priority>>         <<02827>>19520000
         begin  <<should we preempt curr proc?>>               <<02827>>19525000
         if disptoawakemsg.preemptokflag or                    <<02827>>19530000
         disptoawakemsg.curprocqueue<queueinginfo.queuefield   <<06650>>19535000
         then      <<preempt ok flag set or>>                  <<02827>>19540000
            begin  <<curr proc queue less urgent than new q?>> <<02827>>19545000
            if queueinginfo.prifield <                         <<06650>>19550000
                  disptoawakemsg.curprocpri then               <<02827>>19555000
               begin <<really more urgent?, yes!>>             <<02827>>19560000
               if gclassenabledmask.class0 then                         19565000
                  begin  <<measure preemption event>>                   19570000
                  tos:=measstatxdsbank;                                 19575000
                  tos:=measstatxdsbase;                                 19580000
                  tos:=tos+c0sub0'segreloff+c'preempt;         <<ray.v>>19585000
                  asmb(lsea);                                           19590000
                  tos:=tos+1;                                           19595000
                  asmb(ssea;ddel);                                      19600000
                  end;                                                  19605000
               if gclassenabledmask.class15 then               <<01812>>19610000
                  begin <<process level preemption>>           <<01812>>19615000
                  tos:=measprocxdsbank;                        <<01812>>19620000
                  tos:=measprocxdsbase;                        <<01812>>19625000
                  tos := tos + curprc/pcbsize *                <<06650>>19630000
                       class15'sub0size+cp'stoppreempted;      <<01812>>19635000
                  asmb(lsea);                                  <<01812>>19640000
                  tos:=tos+1;                                  <<01812>>19645000
                  asmb(ssea;ddel);                             <<01812>>19650000
                  end;                                         <<01812>>19655000
      <<stuff away reason stopped in pcbx of impeded process>> <<01812>>19660000
      <<done unconditionally for history for meas interface>>  <<01812>>19665000
               waittodispmsg.preemptedflag:=1;                 <<04774>>19670000
               tos:=savedb;                                             19675000
               exchdb;                                                  19680000
               penable;                                                 19685000
               asmb(disp);                                              19690000
               end                                                      19695000
            else                                                        19700000
               begin                                                    19705000
               tos:=savedb;                                             19710000
               exchdb;                                                  19715000
               penable;                                                 19720000
               end;                                                     19725000
            end                                                         19730000
         else                                                           19735000
            begin <<current process not preemptable>>                   19740000
            tos:=savedb;                                                19745000
            exchdb;                                                     19750000
            penable;                                                    19755000
            end;                                                        19760000
         end;                                                           19765000
      end;                                                              19770000
   end;                                                                 19775000
end  <<awake>>;                                                         19780000
                                                                        19785000
$page "PROCESS CONTROL UNCALLABLE INTRINSICS"                           19790000
                                                                        19795000
procedure impede(pcbpt);                                                19800000
value pcbpt;                                                            19805000
integer pcbpt;                                                          19810000
option privileged, uncallable;                                          19815000
                                                                        19820000
comment                                                                 19825000
eliminate calls to this procedure. replace with calls                   19830000
to wait with a specific wait event type.                                19835000
;                                                                       19840000
                                                                        19845000
begin                                                                   19850000
if pcbpt = 0 then                                                       19855000
   begin <<impeding self>>                                              19860000
   tos:=0d;                                                             19865000
   tos.imptrapflag:=1;                                                  19870000
   wait(*,*);                                                           19875000
   end                                                                  19880000
else                                                                    19885000
   begin <<impeding someone else!>>                                     19890000
   disable;                                                             19895000
   pcb(pcbpt+wakemaskwordnum).impededwaitflag:=1;                       19900000
   enable;                                                              19905000
   end;                                                                 19910000
end  <<procedure impede>>;                                              19915000
                                                                        19920000
                                                                        19925000
procedure bumpqpri(holderpin,headpin);                                  19930000
value holderpin,headpin;                                                19935000
integer holderpin,headpin;                                              19940000
option privileged,uncallable;                                           19945000
                                                                        19950000
begin                                                                   19955000
                                                                        19960000
integer mypri;                                                          19965000
integer nextpin;                                                        19970000
double savedb;                                                          19975000
integer pcbpt;                                                 <<06650>>19980000
logical subroutine checkpri(pri);                              <<*7952>>19985000
value pri;                                                     <<*7952>>19990000
integer pri;                                                   <<*7952>>19995000
begin                                                          <<*7952>>20000000
checkpri := false;                                             <<*7952>>20005000
if queueinginfo.lschedflag then                                <<*7952>>20010000
   checkpri := true                                            <<*7952>>20015000
else                                                           <<*7952>>20020000
<<also return true if caller pri. is in non linear queue>>     <<p9084>>20025000
if pri >= ics(-ics'cschedbasecell) then checkpri := true;      <<p9084>>20030000
end;                                                           <<*7952>>20035000
                                                                        20040000
subroutine bumppri;                                                     20045000
begin                                                                   20050000
pcbpt := nextpin * pcbsize;                                    <<06650>>20055000
resabortinfo.holdimppriflag := 1;                              <<06650>>20060000
if integer(queueinginfo).prifield > mypri and                  <<*7952>>20065000
   checkpri(mypri) then                                        <<*7952>>20070000
   begin                                                                20075000
   queueinginfo.prifield:=mypri;                                        20080000
   if queueinginfo.dispqflag then                                       20085000
   queueproc(pcbpt,dispatchingq,endofqueue);                   <<06650>>20090000
   end;                                                                 20095000
end;                                                                    20100000
                                                                        20105000
disable;                                                                20110000
tos:=%1000d;                                                            20115000
asmb(xchd);                                                             20120000
savedb:=tos;                                                            20125000
                                                                        20130000
pcbpt := curprc;                                               <<06650>>20135000
mypri := queueinginfo.prifield;                                <<06650>>20140000
if queueinginfo.lschedflag = 0 then                            <<06650>>20145000
   begin<<adj mypri to base of schedclass>>                    <<06411>>20150000
   if pcb(x).cschedflag=1                                      <<06411>>20155000
   then mypri:=ics(-ics'cschedbasecell)                        <<06411>>20160000
   else if pcb(x).dschedflag=1                                 <<06411>>20165000
   then mypri:=ics(-ics'dschedbasecell)                        <<06411>>20170000
   else if pcb(x).eschedflag=1                                 <<06411>>20175000
   then mypri:=ics(-ics'eschedbasecell);                       <<06411>>20180000
   end;                                                        <<06411>>20185000
nextpin:=holderpin;                                                     20190000
bumppri;                                                                20195000
nextpin:=headpin;                                                       20200000
do                                                                      20205000
   begin                                                                20210000
   if headpin = (curprc)/pcbsize then                          <<06650>>20215000
      nextpin := (curprc)/pcbsize                              <<06650>>20220000
   else                                                        <<06650>>20225000
      begin                                                             20230000
      bumppri;                                                          20235000
      pcbpt := nextpin * pcbsize;                              <<06650>>20240000
      nextpin := nimppin/pcbsize;                              <<06650>>20245000
      end;                                                              20250000
   end                                                                  20255000
until nextpin = (curprc)/pcbsize;                              <<06650>>20260000
tos:=savedb;                                                            20265000
asmb(xchd);                                                             20270000
end  <<bumpqpri>>;                                                      20275000
                                                                        20280000
$page "PCB Impeded List Manipulators : String Pin At Tail"     <<06411>>20285000
                                                               <<06411>>20290000
procedure stringpinattail(headpin,newpin);                     <<06411>>20295000
value headpin,newpin;                                          <<06411>>20300000
integer headpin,newpin;                                        <<06411>>20305000
option privileged,uncallable;                                  <<06411>>20310000
                                                               <<06411>>20315000
comment                                                        <<06411>>20320000
                                                               <<06411>>20325000
stringpinattail places the newpin at the end of the list of the<<06411>>20330000
impeded processes which are strung thru the pcb entries.  the  <<06411>>20335000
head of the impeded list is specified in the headpin parameter,<<06411>>20340000
and the newpin specifies the pin to be added to the tail.      <<06411>>20345000
                                                               <<06411>>20350000
stringpinattail flips thru the list until it gets to the       <<06411>>20355000
end, then adds the newpin at the tail.                         <<06411>>20360000
                                                               <<06411>>20365000
if the newpin parameter is zero, it is assumed that the pin to <<06411>>20370000
strung is that of the currently executing process.             <<06411>>20375000
no assumption is made on db location.                          <<06411>>20380000
                                                               <<06411>>20385000
the caller is responsible for pdisabling or disabling if       <<06411>>20390000
process switches or interrupts could cause the list structure  <<06411>>20395000
to be changed.                                                 <<06411>>20400000
                                                               <<06411>>20405000
                                                               <<06411>>20410000
;                                                              <<06411>>20415000
                                                               <<06411>>20420000
begin                                                          <<06411>>20425000
                                                               <<06411>>20430000
integer prevpix := 0,                                          <<06945>>20435000
        nextpix;                                               <<06650>>20440000
                                                               <<06411>>20445000
if newpin=0 then newpin := (curprc)/pcbsize;                   <<06650>>20450000
nextpix := headpin * pcbsize;                                  <<06650>>20455000
while nextpix <> 0 do                                          <<06650>>20460000
   begin <<locate end of impeded list>>                        <<06411>>20465000
   prevpix := nextpix;                                         <<06650>>20470000
   nextpix := pcb(nextpix + nimppinwordnum);                   <<06650>>20475000
   end;                                                        <<06411>>20480000
                                                               <<06411>>20485000
<<prevpin contains the last pin in the list>>                  <<06411>>20490000
                                                               <<06411>>20495000
<<put newpin into next imp ptr of prev pin pcb>>               <<06411>>20500000
                                                               <<06411>>20505000
if prevpix <> 0 then                                           <<06650>>20510000
   pcb(prevpix + nimppinwordnum) := newpin * pcbsize;          <<06650>>20515000
                                                               <<06411>>20520000
<<zero next ptr of newly added pcb entry>>                     <<06411>>20525000
                                                               <<06411>>20530000
pcb(newpin * pcbsize + nimppinwordnum) := 0;                   <<06650>>20535000
                                                               <<06411>>20540000
end;  <<stringpinatend>>                                       <<06411>>20545000
                                                               <<06411>>20550000
$page "PCB Impeded List Manipulators : String Pin At Tail"     <<06411>>20555000
                                                               <<06411>>20560000
integer procedure unstringheadpin(headpin);                    <<06411>>20565000
value headpin;                                                 <<06411>>20570000
integer headpin;                                               <<06411>>20575000
option privileged,uncallable;                                  <<06411>>20580000
                                                               <<06411>>20585000
comment                                                        <<06411>>20590000
                                                               <<06411>>20595000
unstringheadpin removes the pcb entry specified by the headpin <<06411>>20600000
parameter from the string of pcb entries on the impeded list.  <<06411>>20605000
the new headpin of the list is returned.                       <<06411>>20610000
no assumption is made on db location.                          <<06411>>20615000
                                                               <<06411>>20620000
the caller is responsible for pdisabling or disabling if       <<06411>>20625000
process switches or interrupts could cause the list structure  <<06411>>20630000
to be changed.                                                 <<06411>>20635000
                                                               <<06411>>20640000
                                                               <<06411>>20645000
;                                                              <<06411>>20650000
                                                               <<06411>>20655000
begin                                                          <<06411>>20660000
                                                               <<06411>>20665000
if headpin=0 then suddendeath(sfkernbadparm);                  <<06411>>20670000
                                                               <<06411>>20675000
unstringheadpin := pcb(headpin * pcbsize + nimppinwordnum)     <<06650>>20680000
                      /pcbsize;                                <<06650>>20685000
                                                               <<06411>>20690000
<<zero next ptr of removed pcb entry>>                         <<06411>>20695000
                                                               <<06411>>20700000
pcb(headpin * pcbsize + nimppinwordnum) := 0;                  <<06650>>20705000
                                                               <<06411>>20710000
end;  <<unstringheadpin>>                                      <<06411>>20715000
                                                               <<06411>>20720000
                                                                        20725000
                                                                        20730000
procedure impaired(holder'spin,resindex,p3);                            20735000
value holder'spin,resindex,p3;                                          20740000
integer holder'spin,resindex,p3;                                        20745000
option privileged,uncallable;                                           20750000
                                                                        20755000
begin                                                                   20760000
integer holder'spri,                                                    20765000
        impeder'spri;                                                   20770000
integer pointer respointer;                                             20775000
                                                                        20780000
@respointer:=resindex;                                                  20785000
bumpqpri(holder'spin,respointer(1)/pcbsize);                   <<06650>>20790000
impede(0);                                                              20795000
end;                                                                    20800000
                                                                        20805000
procedure unimpede(pcbpt);                                              20810000
value pcbpt;                                                            20815000
integer pcbpt;                                                          20820000
option privileged,uncallable;                                           20825000
                                                                        20830000
begin                                                                   20835000
awake(pcbpt,impwaitcode,nowait);                                        20840000
end  <<procedure unimpede>>;                                            20845000
                                                                        20850000
                                                                        20855000
procedure delay(interval);                                              20860000
value interval;                                                         20865000
double interval;                                                        20870000
option privileged,uncallable;                                           20875000
                                                                        20880000
comment                                                                 20885000
                                                                        20890000
delay gets an entry in the timer request list on bahalf                 20895000
of the calling process, and waits the calling process                   20900000
until the entry is serviced.  this will occur in                        20905000
(interval +/- 100) ms.                                                  20910000
                                                                        20915000
;                                                                       20920000
                                                                        20925000
begin                                                                   20930000
integer pcbpt;                                                          20935000
logical savecritical;                                                   20940000
                                                                        20945000
disable;                                                                20950000
pcbpt := curprc;                                               <<06650>>20955000
savecritical:=setcritical;                                              20960000
tos:=timereq(5,pcbpt,interval);                                         20965000
<<                                                                      20970000
tos:=timerwaitcode                                                      20975000
tos:=0                                                                  20980000
tos.transcompflag:=1                                                    20985000
wait(*,*)                                                               20990000
>>                                                                      20995000
impede(0);                                                              21000000
enable;                                                                 21005000
aborttimereq(*);                                                        21010000
resetcritical(savecritical);                                            21015000
end <<procedure delay>>;                                                21020000
logical procedure timeout(delay,allowsoftint);                 <<03041>>21025000
value delay,allowsoftint;                                               21030000
                                                                        21035000
<<function                                                              21040000
  delays a process for n milliseconds.>>                                21045000
                                                                        21050000
<<input>>                                                               21055000
  double                                                                21060000
    delay;               <<# milliseconds to delay, -1d implies         21065000
                           infinity>>                                   21070000
  logical                                                               21075000
    allowsoftint;        <<true - soft interrupts or control y may      21080000
                                  abort the timeout                     21085000
                           false- wait for the entire duration>>        21090000
                                                                        21095000
<<output                                                                21100000
    timeout                reason for returning                         21105000
                           0 - timeout occurred                         21110000
                           1 - no trlx entries available                21115000
                           2 - control y/soft interrupt is pending>>    21120000
                                                                        21125000
option privileged,uncallable;                                           21130000
                                                                        21135000
   begin                                                                21140000
   logical                                                              21145000
      done;                                                             21150000
   integer                                                              21155000
      pcbpt,pcbxloc,trlx:=0,result:=timeoutoccurred,delay0=delay,       21160000
      pxfixedloc,                                              <<06686>>21165000
      delay1=delay+1;                                                   21170000
   logical                                                              21175000
      specialinfo;                                                      21180000
   define                                                               21185000
      infinity    = -1d#;                                               21190000
   equate                                                               21195000
      timeoutcode = 10,                                                 21200000
      timeoutwait = -%10,                                               21205000
      allowsoft   = %10000,                                             21210000
      longwait    = 1;                                                  21215000
   integer                                                     <<06943>>21220000
      trlptr;                                                  <<06943>>21225000
                                                                        21230000
                                                                        21235000
   subroutine texit(returnvalue);                                       21240000
   value returnvalue;                                                   21245000
   integer returnvalue;                                                 21250000
      begin                                                             21255000
      timeout:=returnvalue;                                             21260000
      if globaltraceflag then                                           21265000
         mmstat'(mmtimeout,returnvalue,delay0,delay1,0,0,0);   <<06948>>21270000
      asmb(exit 3);                                                     21275000
      end;  <<texit>>                                                   21280000
   <<initialize>>                                                       21285000
   specialinfo := (if delay > 1000d then 1 else 0) +           <<*7954>>21290000
                  (if allowsoftint then allowsoft              <<*7954>>21295000
                     else 0);                                  <<*7954>>21300000
   pxfixed;                                                             21305000
   pcbpt := curprc;                                            <<06650>>21310000
                                                                        21315000
   if delay <> 0d then                                                  21320000
      begin                                                             21325000
      if delay <> infinity then                                         21330000
         begin  <<user desires a delay>>                                21335000
         disable;                                                       21340000
         if not chektrlfree then                                        21345000
            begin                                                       21350000
            enable;                                                     21355000
            texit(trlxexhausted);                                       21360000
            end;                                                        21365000
         pxfxtrlxtout:=trlx:=timereq(timeoutcode,pcbpt,delay); <<06635>>21370000
         enable;                                                        21375000
         end;                                                           21380000
                                                                        21385000
      <<wait loop>>                                                     21390000
      do                                                                21395000
         begin  <<do until timeout/soft int pending>>                   21400000
         done:=true;                                                    21405000
         wait(timeoutwait,specialinfo);                                 21410000
         if > then                                                      21415000
            result:=softintoccurred                                     21420000
         else                                                           21425000
            begin  <<check if wait returned because of pcb wws>>        21430000
            trlptr := trlx*trlentrysize;                       <<06943>>21435000
            if trlx=0 or trlrequest<>0 then                    <<06943>>21440000
               done:=false;  <<another event set the wws>>              21445000
            end                                                         21450000
         end until done;                                                21455000
                                                                        21460000
      <<return the timer request entry>>                                21465000
      if trlx <> 0 then                                                 21470000
         begin                                                          21475000
         pdisable;  <<pseudo disable so that can't be aborted>>         21480000
         aborttimereq(trlx);                                            21485000
         pxfxtrlxtout:=0;                                      <<06635>>21490000
         penable;                                                       21495000
         end;                                                           21500000
      end;                                                              21505000
                                                                        21510000
   texit(result);                                                       21515000
   end;  <<timeout>>                                                    21520000
$page "RESOURCE EXCLUSION AND PROTECTION : SET / RESET CRITICAL"        21525000
                                                                        21530000
                                                                        21535000
                                                                        21540000
logical procedure setcritical;                                          21545000
option privileged,uncallable;                                  <<01696>>21550000
                                                                        21555000
comment                                                                 21560000
setcritical sets the flag in the pcb which keep the process             21565000
from being aborted.  the value of setcritical returned to the           21570000
caller indicates whether the process was already in a critical          21575000
state, and this value must be returned when resetcritical is            21580000
called so that the process may be protected even though nested          21585000
calls to setcritical may have been made.                                21590000
;                                                                       21595000
                                                                        21600000
begin                                                                   21605000
integer pcbpt;                                                 <<06650>>21610000
disable;                                                                21615000
pcbpt := curprc;                                               <<06650>>21620000
setcritical := resabortinfo.critflag;                          <<06650>>21625000
resabortinfo.critflag := 1;                                    <<06650>>21630000
end;  <<procedure setcritical>>                                         21635000
                                                                        21640000
procedure resetcritical(oldcritical);                                   21645000
value oldcritical;                                                      21650000
logical oldcritical;                                                    21655000
option privileged,uncallable;                                           21660000
                                                                        21665000
                                                                        21670000
comment                                                                 21675000
resetcritical restores the process to an abortable state                21680000
unless the process had nested calls to setcritical.  if                 21685000
an abort is pending against the process and it is no                    21690000
longer critical, pseudoint is called.                                   21695000
;                                                                       21700000
                                                                        21705000
begin                                                                   21710000
integer pcbpt;                                                 <<06650>>21715000
if not oldcritical then                                                 21720000
   begin                                                                21725000
   disable;                                                             21730000
   pcbpt := curprc;                                            <<06650>>21735000
   resabortinfo.critflag := 0;                                 <<06650>>21740000
   resabortinfo.holdimppriflag := 0;                           <<06650>>21745000
   if resabortinfo.piovrflag then                              <<06650>>21750000
      begin                                                             21755000
      if not resabortinfo.hassirflag then                      <<06650>>21760000
         begin                                                          21765000
         resabortinfo.piovrflag := 0;                          <<06650>>21770000
         if ics(-ics'pdiscntcell) > 0                                   21775000
         or status.(1:1) = 0 <<pdisabled or disabled>>                  21780000
         then asmb(disp) <<delay service till next launch>> else        21785000
            begin                                                       21790000
            if procstate.hybernateflag                         <<06650>>21795000
            or procstate.stopflag then asmb(disp) else         <<06650>>21800000
               begin                                                    21805000
               pdisable;                                                21810000
               enable;                                                  21815000
               pseudoint;                                               21820000
               end;                                                     21825000
            end;                                                        21830000
         end;                                                           21835000
      end;                                                              21840000
   if procstate.stovflag = 1                                   <<06650>>21845000
   and not resabortinfo.stovabortflag                          <<06650>>21850000
   and not stkinfo.insystemflag and not                        <<06650>>21855000
   resabortinfo.hassirflag then                                <<06650>>21860000
      begin <<was disabled or pdisabled when overflowed, not in system>>21865000
      resabortinfo.stovabortflag := 1;                         <<06650>>21870000
      abort([8/1,8/4],0,0);                                    <<04486>>21875000
      end;                                                              21880000
   end;                                                                 21885000
end  <<procedure resetcritical>>;                                       21890000
                                                                        21895000
$page "RESOURCE EXCLUSION AND PROTECTION : GET SIR"                     21900000
                                                                        21905000
integer procedure getsir(sirnumber);                                    21910000
value sirnumber;                                                        21915000
integer sirnumber;                                                      21920000
option privileged,uncallable;                                           21925000
                                                                        21930000
comment                                                                 21935000
                                                                        21940000
getsir is called to obtain exclusive access to a resource which         21945000
is protected by the queueing semaphore passed as parameter.  if         21950000
the sir is busy, the process is queued by priority through a            21955000
doubly linked list strung through pcb entries.  if the holder of        21960000
the resource is of less urgent priority than the requestor, the         21965000
holder's priority is temporarily bumped until he releases the           21970000
resource.                                                               21975000
                                                                        21980000
the return value indicates whether the process already holds a          21985000
sir, and whether the caller already holds the sir it's currently        21990000
requesting.  this value should be saved and passed along to             21995000
relsir so that proper accounting can be maintained.                     22000000
                                                                        22005000
   getsir = 1 ==> process already held some sir                         22010000
   getsir = 3 ==> process alreday holds the sir its requesting          22015000
   getsir = 0 ==> process is acquiring its first sir                    22020000
                                                                        22025000
;                                                                       22030000
                                                                        22035000
begin                                                                   22040000
integer sirtabinx,                                                      22045000
        reqpcbpt,                                                       22050000
        reqpri,                                                         22055000
        pcbpt,                                                 <<06650>>22060000
        reqprocinx,                                                     22065000
        holderprocinx,                                         <<06650>>22070000
        headprocinx,                                                    22075000
        prevprocinx,                                                    22080000
        nextprocinx;                                                    22085000
double savedb;                                                          22090000
integer sirn=sirnumber;                                                 22095000
integer bumpprocinx;                                           <<06650>>22100000
                                                               <<06411>>22105000
                                                               <<06411>>22110000
subroutine bumpsirproc;                                        <<06411>>22115000
                                                               <<06411>>22120000
comment                                                        <<06411>>22125000
                                                               <<06411>>22130000
raises pri of bumppin to at least reqpin's pri                 <<06411>>22135000
                                                               <<06411>>22140000
;                                                              <<06411>>22145000
                                                               <<06411>>22150000
begin                                                          <<06411>>22155000
pcbpt := bumpprocinx;                                          <<06650>>22160000
if not queueinginfo.lschedflag then                            <<06411>>22165000
   begin                                                       <<06411>>22170000
   disable;                                                    <<06411>>22175000
   resabortinfo.holdsirpriflag:=1;                             <<06411>>22180000
   if integer(queueinginfo.prifield) > reqpri then             <<06411>>22185000
      begin                                                    <<06411>>22190000
      queueinginfo.prifield:=reqpri;                           <<06411>>22195000
      if queueinginfo.dispqflag                                <<06411>>22200000
      then queueproc(pcbpt,dispatchingq,endofqueue);           <<06650>>22205000
      end;                                                     <<06411>>22210000
   end;                                                        <<06411>>22215000
end <<bumpsirproc>>;                                           <<06411>>22220000
                                                               <<06411>>22225000
                                                               <<06411>>22230000
                                                                        22235000
turnofftraps;                                                  <<01860>>22240000
                                                               <<01860>>22245000
reqprocinx := pcbpt := (curprc);                               <<06650>>22250000
pdisable;                                                      <<01846>>22255000
sirtabinx := sirnumber*sirtabentrylength;                      <<06264>>22260000
holderprocinx := sir'holder;                                   <<06650>>22265000
if holderprocinx = reqprocinx then                             <<06650>>22270000
   begin <<requestor already holds sir>>                       <<01846>>22275000
   getsir:=3; <<so we can distinguish at release time>>        <<01846>>22280000
   penable;                                                    <<01846>>22285000
   end                                                         <<01846>>22290000
else                                                           <<01846>>22295000
   begin  <<go for it>>                                        <<01846>>22300000
   tos := resabortinfo;                                        <<06650>>22305000
   assemble(tbc hassirbit);                                             22310000
   if <> then getsir:=1  <<indicates proc already held a sir>>          22315000
   else getsir:=0;                                                      22320000
   if holderprocinx = 0 then                                   <<06650>>22325000
      begin  <<sir is available>>                                       22330000
      <<                                                                22335000
      if sirn < %50 then                                                22340000
         begin                                                          22345000
         tos:=%1000d;asmb(xchd);x:=sirn*6+700+1;measbuf(x):=timer;      22350000
         x:=sirn*6+700+5;                                               22355000
         measbuf(x):=measbuf(x)+1d;                                     22360000
         asmb(xchd;ddel);                                               22365000
         end;                                                           22370000
      >>                                                                22375000
      sir'holder := pcbpt;                                     <<06650>>22380000
      resabortinfo.hassirflag := 1;                            <<06650>>22385000
      penable;                                                          22390000
      end                                                               22395000
   else                                                                 22400000
      begin <<sir is busy, so process must queue for it>>               22405000
      tos:=%1000d;                                                      22410000
      assemble(xchd); <<for fast addressing>>                           22415000
      savedb:=tos;                                                      22420000
      if gclassenabledmask.class0 then                                  22425000
         begin  <<measure sir block process stop event>>                22430000
         tos:=measstatxdsbank;                                          22435000
         tos:=measstatxdsbase;                                          22440000
         tos:=tos+c0sub0'segreloff+c'stopsir;                  <<ray.v>>22445000
         asmb(lsea);                                                    22450000
         tos:=tos+1;                                                    22455000
         asmb(ssea;ddel);                                               22460000
         end;                                                           22465000
      <<                                                                22470000
      x:=sirn*6+700+4;if sirn < %50 then                                22475000
      measbuf(x):=measbuf(x)+1d;  #busy sir stops on this sir           22480000
      >>                                                                22485000
      reqpri:=queueinginfo.prifield;                                    22490000
      sir'queuelen := sir'queuelen+1; <<bump q length>>        <<06264>>22495000
      headprocinx := sir'head;                                 <<06650>>22500000
      if = then                                                         22505000
         begin <<queue is empty>>                                       22510000
         << req at head and tail >>                            <<06264>>22515000
         sir'head := sir'tail := reqprocinx;                   <<06650>>22520000
         <<                                                             22525000
         if sirn < %50 then                                             22530000
            begin                                                       22535000
            x:=sirn*6+700;                                              22540000
            measbuf(x):=timer;                                          22545000
            end;                                                        22550000
         >>                                                             22555000
         nimppin := 0;                                         <<06650>>22560000
         pimppin := 0;                                         <<06650>>22565000
         bumpprocinx := holderprocinx;                         <<06650>>22570000
         bumpsirproc;                                          <<06411>>22575000
         end                                                            22580000
      else                                                              22585000
         begin  <<q at tail, bump pri of guys in front>>       <<06411>>22590000
            prevprocinx := sir'tail;                           <<06650>>22595000
            sir'tail := reqprocinx;                            <<06650>>22600000
            pcbpt := prevprocinx;                              <<06650>>22605000
            nimppin := reqprocinx;                             <<06650>>22610000
            pcbpt := reqprocinx;                               <<06650>>22615000
            pimppin := prevprocinx;                            <<06650>>22620000
            nimppin := 0;                                      <<06650>>22625000
            <<bump everybody to at least his pri>>             <<06411>>22630000
                                                               <<06411>>22635000
            bumpprocinx := holderprocinx;                      <<06650>>22640000
            bumpsirproc;                                       <<06411>>22645000
            bumpprocinx := headprocinx;                        <<06650>>22650000
            while bumpprocinx <> reqprocinx do                 <<06650>>22655000
               begin                                           <<06411>>22660000
               bumpsirproc;                                    <<06411>>22665000
               pcbpt := bumpprocinx;                           <<06650>>22670000
               bumpprocinx := nimppin;                         <<06650>>22675000
               end;                                            <<06411>>22680000
         end;                                                  <<02873>>22685000
      <<bump holder's priority?>>                              <<02873>>22690000
      pcbpt := holderprocinx;                                  <<06650>>22695000
      if not queueinginfo.lschedflag then                      <<06650>>22700000
         begin                                                 <<02873>>22705000
         disable;                                              <<02873>>22710000
         resabortinfo.holdsirpriflag := 1;                     <<06650>>22715000
         if integer(queueinginfo.prifield)>reqpri then         <<06650>>22720000
            begin                                              <<02873>>22725000
            queueinginfo.prifield := reqpri;                   <<06650>>22730000
            if queueinginfo.dispqflag                          <<06650>>22735000
            then queueproc(pcbpt,dispatchingq,endofqueue);     <<06650>>22740000
            end;                                               <<02873>>22745000
         end;                                                           22750000
      tos:=savedb;                                                      22755000
      asmb(xchd);                                                       22760000
      wait(sirwaitcode,noinfo);                                         22765000
      end;                                                              22770000
   end;                                                                 22775000
end  <<procedure getsir>>;                                              22780000
                                                                        22785000
                                                                        22790000
$page "RESOURCE EXCLUSION AND PROTECTION : RELEASE SIR"                 22795000
                                                                        22800000
procedure relsir(sirnumber,savedvalue);                                 22805000
value sirnumber,savedvalue;                                             22810000
integer sirnumber,savedvalue;                                           22815000
option privileged,uncallable;                                           22820000
                                                                        22825000
                                                                        22830000
comment                                                                 22835000
                                                                        22840000
relsir releases the access lock to the system resource protected        22845000
by the queueing semaphore passed as parameter.  the value returned      22850000
from getsir is passed along as parameter, and is used to determine      22855000
if the process had nested calls to the same sir (in which case the      22860000
sir lock is not released) and whether the process is releasing          22865000
its last sir (in which case it can field nasty pseudo-interrupts        22870000
which could result in the process being aborted).                       22875000
                                                                        22880000
the resource is given to the head of the sir queue, which is the        22885000
most urgent process waiting on the sir due to the queue's priority      22890000
structure.                                                              22895000
                                                                        22900000
if the process had its priority bumped due to more urgent processes     22905000
queueing for the resource, the next rescheduling will put it back       22910000
where it belongs.                                                       22915000
                                                                        22920000
;                                                                       22925000
                                                                        22930000
begin                                                                   22935000
integer sirtabinx,                                                      22940000
        headprocinx,                                                    22945000
        tailprocinx,                                                    22950000
        pcbpt,                                                 <<06650>>22955000
        relprocinx,                                                     22960000
        prevprocinx,                                                    22965000
        nextprocinx;                                                    22970000
integer sirn=sirnumber;                                                 22975000
                                                               <<01860>>22980000
turnofftraps;                                                  <<01860>>22985000
                                                               <<01860>>22990000
if savedvalue <> 3  then                                                22995000
   begin <<process should give up the sir>>                             23000000
   pdisable;                                                            23005000
   tos := relprocinx := pcbpt := curprc;                       <<06650>>23010000
   sirtabinx := sirnumber*sirtabentrylength;                   <<06264>>23015000
   tos := sir'holder;                                          <<06264>>23020000
   assemble(cmp);                                                       23025000
   if <> then resabortinfo                                     <<06650>>23030000
            .hassirflag:=savedvalue else                                23035000
      begin <<caller had the sir>>                                      23040000
      sir'holder := 0;                                         <<06264>>23045000
      <<give the sir to the head of the queue>>                         23050000
      tos := sir'head;                                         <<06264>>23055000
      if = then                                                         23060000
         begin <<queue empty-meas end of busy interval>>                23065000
            <<                                                          23070000
         if sirn < %50 then                                             23075000
            begin                                                       23080000
            tos:=%1000d;                                                23085000
            asmb(xchd);                                                 23090000
            x:=700+sirn*6+1;                                            23095000
            tos:=timer-measbuf(x);                                      23100000
            x:=700+sirn*6+2;                                            23105000
            measbuf(x):=measbuf(x)+tos;                                 23110000
            asmb(xchd;ddel);                                            23115000
            end;                                                        23120000
            >>                                                          23125000
         end                                                            23130000
      else                                                              23135000
         begin  <<queue is non-empty>>                                  23140000
         headprocinx := sir'head;                              <<06650>>23145000
         tailprocinx := sir'tail;                              <<06650>>23150000
         sir'queuelen := sir'queuelen-1;                       <<06264>>23155000
         sir'holder := headprocinx;                            <<06650>>23160000
            <<                                                          23165000
         if sirn < %50 and headpin=tailpin then                         23170000
            begin                                                       23175000
            tos:=%1000d;                                                23180000
            asmb(xchd);                                                 23185000
            x:=700+sirn*6;                                              23190000
            tos:=timer-measbuf(x);                                      23195000
            x:=700+sirn*6+3;                                            23200000
            measbuf(x):=measbuf(x)+tos;                                 23205000
            asmb(xchd;ddel);                                            23210000
            end;                                                        23215000
            >>                                                          23220000
         if headprocinx = tailprocinx then                     <<06650>>23225000
            begin                                              <<06264>>23230000
            sir'head := 0;                                     <<06264>>23235000
            sir'tail := 0;                                     <<06264>>23240000
            end                                                <<06264>>23245000
         else                                                  <<06264>>23250000
            begin <<more than one in queue>>                            23255000
            tos:=pcb(headprocinx+nimppinwordnum);              <<06650>>23260000
            sir'head := s0; <<new head>>                       <<06264>>23265000
            pcb(s0 + pimppinwordnum) := 0;                     <<06650>>23270000
            end;                                                        23275000
         pcb(headprocinx+nimppinwordnum) := 0;                 <<06650>>23280000
         pcbpt := headprocinx;                                 <<06650>>23285000
         resabortinfo.hassirflag := 1;                         <<06650>>23290000
         resabortinfo.holdsirpriflag := 1;                     <<06650>>23295000
         awake(headprocinx,sirwaitcode,nowait);                <<06650>>23300000
         end;                                                           23305000
      if not logical(savedvalue) then                                   23310000
         begin <<process giving up its last sir>>                       23315000
         pcbpt := relprocinx;                                  <<06650>>23320000
         tos := resabortinfo;                                  <<06650>>23325000
         tos.holdsirpriflag:=0;                                         23330000
         tos.hassirflag:=0;                                             23335000
         resabortinfo := s0;                                   <<06650>>23340000
         assemble(tbc piovrbit);                                        23345000
         if <> then                                                     23350000
            begin                                                       23355000
            assemble(tbc critbit);                                      23360000
            if = then                                                   23365000
               begin                                                    23370000
               resabortinfo                                    <<06650>>23375000
               .piovrflag:=0;                                           23380000
               if ics(-ics'pdiscntcell) > 1                             23385000
               or status.(1:1) = 0 <<pdisabled or disabled>>            23390000
               then asmb(disp) <<delay service till next launch>> else  23395000
                  begin                                                 23400000
                  if procstate.hybernateflag                   <<06650>>23405000
                  or procstate.stopflag then asmb(disp) else   <<06650>>23410000
                     begin                                              23415000
                     enable;                                            23420000
                     pseudoint;                                         23425000
                     pdisable;                                          23430000
                     end;                                               23435000
                  end;                                                  23440000
               end;                                                     23445000
            end;                                                        23450000
         end;                                                           23455000
      end;                                                              23460000
   penable;                                                             23465000
   end;                                                                 23470000
end  <<procedure relsir>>;                                              23475000
                                                                        23480000
                                                                        23485000
                                                                        23490000
$page "DB MANIPULATION PROCEDURES"                                      23495000
                                                                        23500000
comment                                                                 23505000
                                                                        23510000
db may be placed at the stack db, the base of an extra data segment,    23515000
or at an absolute location.                                             23520000
                                                                        23525000
to place db at sysdb, call procedure setsysdb, then call resetdb        23530000
passing the value returned by setsysdb in order to restore the          23535000
previous environment.                                                   23540000
                                                                        23545000
to place db at an absolute location in bank 0 other than at sys db,     23550000
first call setsysdb, then call resetdb with the desired value.          23555000
when done, call resetdb with the value returned from                    23560000
setsysdb.                                                               23565000
                                                                        23570000
to place db at a specific data segment, call exchangedb supplying       23575000
the desired data segment's number (0 if caller's stack).  save the      23580000
value returned and supply this on the call to exchangedb which is to    23585000
restore the previous environment.                                       23590000
                                                                        23595000
;                                                                       23600000
$page "DB MANIPULATION PROCEDURES : SETSYSDB"                           23605000
logical procedure setsysdb;                                             23610000
option privileged,uncallable;                                           23615000
                                                                        23620000
comment                                                                 23625000
setsysdb loads the db register with the sysbase value and               23630000
sets a flag in the calling process' pcb to indicate that                23635000
db points at an absolute location.                                      23640000
                                                                        23645000
setsysdb returns a value which the caller should save and pass as       23650000
parameter to resetdb so that the previous environment may be            23655000
properly restored.  the returned value is -1 if db was not              23660000
already set to an absolute location, and is the previous db value       23665000
if db was at an absolute location.                                      23670000
                                                                        23675000
;                                                                       23680000
                                                                        23685000
begin                                                                   23690000
integer pcbpt;                                                 <<06650>>23695000
logical                                                        <<06650>>23700000
   at'absolute'db := false;                                    <<06650>>23705000
pdisable;                                                               23710000
pcbpt := curprc;                                               <<06650>>23715000
at'absolute'db := dbxdsinfo.absdbflag;                         <<06650>>23720000
dbxdsinfo.absdbflag := 1;                                      <<06650>>23725000
if not at'absolute'db then                                     <<06650>>23730000
   begin                                                                23735000
   tos:=0;                                                              23740000
   tos:=sysbase;                                                        23745000
   exchdb;                                                              23750000
   setsysdb:=-1;                                                        23755000
   end                                                                  23760000
else                                                                    23765000
   begin <<already at an abs location>>                                 23770000
   tos:=0;                                                              23775000
   tos:=sysbase;                                                        23780000
   asmb(xchd);                                                          23785000
   setsysdb:=tos;                                                       23790000
   end;                                                                 23795000
penable;                                                                23800000
end <<procedure setsysdb>>;                                             23805000
$page "DB MANIPULATION PROCEDURES : RESETDB"                            23810000
                                                                        23815000
procedure resetdb(where);                                               23820000
value where;                                                            23825000
integer where;                                                          23830000
option privileged,uncallable;                                           23835000
                                                                        23840000
comment                                                                 23845000
                                                                        23850000
resetdb is called after calling setsysdb to restore db to the           23855000
value that was expected upon calling setsysdb.                          23860000
                                                                        23865000
the value returned by setsysdb should be supplied as the                23870000
parameter for resetdb.                                                  23875000
                                                                        23880000
;                                                                       23885000
                                                                        23890000
begin                                                                   23895000
integer pcbpt,dstnumber;                                       <<06650>>23900000
                                                               <<01860>>23905000
turnofftraps;                                                  <<01860>>23910000
                                                               <<01860>>23915000
tos:=where;                                                             23920000
if = then suddendeath(611);                                    <<01644>>23925000
if s0 <> -1 then                                                        23930000
   begin <<put passed value into db>>                                   23935000
   tos:=0;                                                              23940000
   asmb(xch;xchd);                                                      23945000
   end                                                                  23950000
else                                                                    23955000
   begin  <<db back to pcb's dbinfo>>                                   23960000
   disable;<<pdis in mulit-cpu>>                                        23965000
                                                                        23970000
   checkagain:                                                          23975000
   pcbpt := curprc;                                            <<06650>>23980000
   tos := dbxdsinfo;                                           <<06650>>23985000
   tos.absdbflag:=0;                                                    23990000
   dbxdsinfo := s0;                                            <<06650>>23995000
   dstnumber:=tos.xdsdstfield;                                          24000000
   if <> then                                                           24005000
      begin <<xds>>                                                     24010000
      if logical(dst(dstnumber&lsl(2))).absentflag then                 24015000
         begin <<clock ate it up>>                                      24020000
          queueonobject(double(dstnumber));                    <<06660>>24025000
          go checkagain;                                                24030000
          end;                                                          24035000
      dst(x).referencedflag:=1;                                         24040000
      tos:=dst(x:=x+2);                                                 24045000
      tos:=dst(x:=x+1);                                                 24050000
      end                                                               24055000
   else                                                                 24060000
      begin  <<goes back to stk>>                                       24065000
      tos:=ics(-ics'stkbankcell);                                       24070000
      tos:=ics(x:=x+1);                                                 24075000
      end;                                                              24080000
   asmb(xchd);                                                          24085000
   end;                                                                 24090000
end  <<procedure resetdb>>;                                             24095000
                                                                        24100000
$page "DB MANIPULATION PROCEDURES : EXCHANGEDB"                         24105000
logical procedure exchangedb(where);                                    24110000
value where;                                                            24115000
integer where;                                                          24120000
option privileged,uncallable;                                           24125000
                                                                        24130000
                                                                        24135000
comment                                                                 24140000
                                                                        24145000
exchangedb is called to put db at the base of a data segment            24150000
or to return db to the caller's stack db.  the destination data         24155000
segment number is supplied as parameter if not returning to the         24160000
stack.  if returning to the stack, supply 0 as parameter.               24165000
                                                                        24170000
exchangedb returns the dst number of where db was (0 if stack).         24175000
this value may be saved and returned on the next call to exchangedb     24180000
to restore the previous environment.                                    24185000
                                                                        24190000
;                                                                       24195000
                                                                        24200000
begin                                                                   24205000
                                                                        24210000
logical deltap=q-2;                                            <<01571>>24215000
logical status=q-1;                                            <<01571>>24220000
integer procinx,                                                        24225000
        pcbpt;                                                 <<06660>>24230000
double obj := 0d;                                              <<06660>>24235000
logical array objident(*)=obj;                                 <<06660>>24240000
integer descstinx;                                             <<06660>>24245000
                                                                        24250000
turnofftraps;                                                  <<01860>>24255000
                                                               <<01860>>24260000
pdisable;                                                               24265000
<<mmstat'(mmstatexchdb,where,deltap,status,0,0,0);>>           <<06948>>24270000
cpunum;                                                        <<04663>>24275000
if tos= series64 then update'ics'xdsegbnkcell;                 <<04663>>24280000
tos:=%1000d;                                                            24285000
asmb(xchd);  <<for fast addressing>>                                    24290000
procinx := pcbpt := curprc;                                    <<06650>>24295000
tos:=dbxdsinfo;                                                         24300000
if < then suddendeath(611); <<must reset first>>               <<01644>>24305000
exchangedb:=tos.xdsdstfield;                                            24310000
tos:=where;                                                             24315000
tos.(0:1):=0;  <<discard clean bit>>                                    24320000
dbxdsinfo.xdsdstfield := s0;                                   <<06650>>24325000
objident(objidnumfield):=s0;                                   <<06660>>24330000
if s0=0 then                                                   <<06660>>24335000
   begin  <<db goes to stk>>                                            24340000
   tos:=ics(-ics'stkbankcell);                                          24345000
   tos:=ics(x:=x+1);                                                    24350000
   asmb(xchd);                                                          24355000
   end                                                                  24360000
else                                                                    24365000
   begin <<going to an xds>>                                            24370000
      if dst(0) < s0 then suddendeath(611); <<out of range>>   <<01644>>24375000
   disable;                                                             24380000
   descstinx:=tos & lsl(2);                                    <<06005>>24385000
   if dst(descstinx)=%100000 then                              <<06005>>24390000
      suddendeath(625);                                        <<06005>>24395000
   if not logical(dst(descstinx)).absentflag then              <<06005>>24400000
      begin  <<new db seg is present>>                                  24405000
      cpunum;           << get cpu number >>                   <<04663>>24410000
      if tos= series64 then                                    <<04663>>24415000
                                                               <<04663>>24420000
        begin                                                  <<04663>>24425000
        get'xdseg'limits;                                      <<04663>>24430000
        xfer'xdseg'limits;                                     <<04663>>24435000
        end;                                                   <<04663>>24440000
                                                               <<04663>>24445000
      tos:=dst(x:=x+2);                                                 24450000
      tos:=dst(x:=x+1);                                                 24455000
      asmb(xchd);                                                       24460000
      end                                                               24465000
   else                                                                 24470000
      begin <<not present>>                                             24475000
      enable;                                                           24480000
      if logical(dst(x:=x+1)).rocflag then                              24485000
         begin                                                          24490000
         if gclassenabledmask.class0 then                               24495000
            begin  <<measure recovery of data seg by process>>          24500000
            tos:=measstatxdsbank;                                       24505000
            tos:=measstatxdsbase;                                       24510000
            tos:=tos+c0sub0'segreloff+c'datarecovery;          <<ray.v>>24515000
            asmb(lsea);                                                 24520000
            tos:=tos+1;                                                 24525000
            asmb(ssea;ddel);                                            24530000
            end;                                                        24535000
         recoveroc(obj,descstinx,0d);                          <<06660>>24540000
         end                                                            24545000
      else                                                              24550000
         begin  <<really absent>>                                       24555000
         queueonobject(obj);                                   <<06660>>24560000
         pdisable;                                                      24565000
         end;                                                           24570000
         x:= descstinx;    << set x = to dst entry >>          <<04663>>24575000
         cpunum;           << get cpu number >>                <<04663>>24580000
         if tos= series64 then                                 <<04663>>24585000
                                                               <<04663>>24590000
           begin                                               <<04663>>24595000
           get'xdseg'limits;                                   <<04663>>24600000
           xfer'xdseg'limits;                                  <<04663>>24605000
           end;                                                <<04663>>24610000
                                                               <<04663>>24615000
      tos:= dst(x:= x+2);                                      <<04663>>24620000
      tos:=dst(x:=x+1);                                                 24625000
      asmb(xchd);                                                       24630000
      end;                                                              24635000
   dst(descstinx).referencedflag:=1;                                    24640000
   end;                                                                 24645000
penable;                                                                24650000
end  <<procedure exchangedb>>;                                          24655000
$page "DB MANIPULATION PROCEDURES : CHANGEDB"                  <<04324>>24660000
double procedure changedb(newdb);                              <<04324>>24665000
value                     newdb ;                              <<04324>>24670000
double                    newdb ;                              <<04324>>24675000
option privileged, uncallable;                                 <<04324>>24680000
begin                                                          <<04324>>24685000
                                                               <<04324>>24690000
comment --george r. o'connor. hp boise division (11/20/81).    <<04324>>24695000
                                                               <<04324>>24700000
purpose:  performs  an extended exchangedb  to handle db being <<04324>>24705000
set to an absolute address, in bank zero.                      <<04324>>24710000
                                                               <<04324>>24715000
error   reporting:   no  error  reporting  occurs  explicitly. <<04324>>24720000
suddendeath's  may result from some  of the kernelc procedures <<04324>>24725000
which are called.                                              <<04324>>24730000
                                                               <<04324>>24735000
external references:                                           <<04324>>24740000
                     exchangedb                                <<04324>>24745000
                    ,fixed low memory                          <<04324>>24750000
                    ,pcb                                       <<04324>>24755000
                    ,resetdb                                   <<04324>>24760000
                    ,setsysdb                                  <<04324>>24765000
                                                               <<04324>>24770000
input:                                                         <<04324>>24775000
     newdb  := a double word value which indicates where db is <<04324>>24780000
to  be set to.  if newdb < 0d  then db will be set to the data <<04324>>24785000
segment number -newdb.  if newdb = 0d then db will be returned <<04324>>24790000
to  the process's stack location.  if  newdb = 1d then db will <<04324>>24795000
be  returned  to the data segment or  stack location it was at <<04324>>24800000
before  being set to an absolute location.  if newdb > 1d then <<04324>>24805000
db  will  be set to the absolute  address of newdb.  note that <<04324>>24810000
this  permits  db  to be set to  absolute locations outside of <<04324>>24815000
bank zero.                                                     <<04324>>24820000
                                                               <<04324>>24825000
output:                                                        <<04324>>24830000
    changedb  :=  the  value which the  caller should save and <<04324>>24835000
pass  back to changedb so that the previous environment may be <<04324>>24840000
properly  restored.   if  db  was  at  the  stack  then  0d is <<04324>>24845000
returned.   if  db was set to the  base of a data segment then <<04324>>24850000
the negative data segment number is returned.  if db was at an <<04324>>24855000
absolute  location  then  the  absolute  address  location  is <<04324>>24860000
returned.                                                      <<04324>>24865000
                                                               <<04324>>24870000
side effects:                                                  <<04324>>24875000
     the  dbxdsinfo word of the  current process control block <<04324>>24880000
may be changed.                                                <<04324>>24885000
                                                               <<04324>>24890000
special considerations:                                        <<04324>>24895000
     highly privileged.                                        <<04324>>24900000
;                                                              <<04324>>24905000
$page "PROCEDURE: CHANGEDB;  LOCAL DECLARATIONS"               <<04324>>24910000
integer                                                        <<04324>>24915000
        pcbpt                                                  <<06650>>24920000
;                                                              <<04324>>24925000
logical                                                        <<04324>>24930000
        db'is'absolute                                         <<04324>>24935000
;                                                              <<04324>>24940000
$page "DB MANIPULATION PROCEDURES : CHANGEDB"                  <<04324>>24945000
                                                               <<04324>>24950000
<<determine if db is at an absolute location.also the x     >> <<04324>>24955000
<<register is set to point to the absolute address of the db>> <<04324>>24960000
<<xds information word in the current process               >> <<06650>>24965000
<<control block (cpcb).  this is done for speed.            >> <<04324>>24970000
                                                               <<04324>>24975000
pcbpt := curprc;                                               <<06650>>24980000
db'is'absolute := dbxdsinfo.absdbflag;                         <<06650>>24985000
                                                               <<04324>>24990000
if newdb <= 0d then                                            <<04324>>24995000
                                                               <<04324>>25000000
<<newdb is a request for db to be set to a data segment or  >> <<04324>>25005000
<<stack location.                                           >> <<04324>>25010000
                                                               <<04324>>25015000
  begin                                                        <<04324>>25020000
  if db'is'absolute then                                       <<04324>>25025000
                                                               <<04324>>25030000
<<return absolute db and reset db to the valid data segment >> <<04324>>25035000
<<base or stack location and then exchangedb to the data    >> <<04324>>25040000
<<segment or stack reqested.                                >> <<04324>>25045000
                                                               <<04324>>25050000
    begin                                                      <<04324>>25055000
                                                               <<04324>>25060000
<<return absolute db.                                       >> <<04324>>25065000
                                                               <<04324>>25070000
    push(db);                                                  <<04324>>25075000
    changedb := tos;                                           <<04324>>25080000
                                                               <<04324>>25085000
<<reset db to a valid data segment base or stack location.  >> <<04324>>25090000
                                                               <<04324>>25095000
    resetdb(-1);                                               <<04324>>25100000
    exchangedb( - integer ( newdb ) );                         <<04324>>25105000
    end                                                        <<04324>>25110000
                                                               <<04324>>25115000
  else                                                         <<04324>>25120000
                                                               <<04324>>25125000
<<return the inverted old data segment/stack number and >>     <<04324>>25130000
<<exchangedb to the data segment or stack requested.    >>     <<04324>>25135000
                                                               <<04324>>25140000
    changedb := double( - integer(                             <<04324>>25145000
                exchangedb( - integer( newdb ) ) ) );          <<04324>>25150000
  end                                                          <<04324>>25155000
else                                                           <<04324>>25160000
                                                               <<04324>>25165000
  if newdb = 1d then                                           <<04324>>25170000
                                                               <<04324>>25175000
<<newdb is a request for db to be returned to the data >>      <<04324>>25180000
<<segment or stack location it was at before being set >>      <<04324>>25185000
<<to an absolute location.                             >>      <<04324>>25190000
                                                               <<04324>>25195000
    begin                                                      <<04324>>25200000
    if db'is'absolute then                                     <<04324>>25205000
                                                               <<04324>>25210000
<<return the absolute db location and reset db to the  >>      <<04324>>25215000
<<data segment or stack location it was at before being>>      <<04324>>25220000
<<set to an absolute location.                         >>      <<04324>>25225000
                                                               <<04324>>25230000
      begin                                                    <<04324>>25235000
                                                               <<04324>>25240000
<<return absolute db. >>                                       <<04324>>25245000
                                                               <<04324>>25250000
      push(db);                                                <<04324>>25255000
      changedb := tos;                                         <<04324>>25260000
                                                               <<04324>>25265000
<<reset db to the data segment or stack location it was >>     <<04324>>25270000
<<at before being set to an absolute location.          >>     <<04324>>25275000
                                                               <<04324>>25280000
      resetdb(-1);                                             <<04324>>25285000
      end                                                      <<04324>>25290000
                                                               <<04324>>25295000
    else                                                       <<04324>>25300000
                                                               <<04324>>25305000
<<the requester is at his request.  if the extra data >>       <<04324>>25310000
<<segment number is zero then db is at its stack.     >>       <<04324>>25315000
                                                               <<04324>>25320000
      changedb := double(-integer(dbxdsinfo));                 <<06751>>25325000
    end                                                        <<04324>>25330000
                                                               <<04324>>25335000
  else                                                         <<04324>>25340000
                                                               <<04324>>25345000
<< newdb is a request for an absolute address db. >>           <<04324>>25350000
                                                               <<04324>>25355000
    begin                                                      <<04324>>25360000
    if db'is'absolute then                                     <<04324>>25365000
                                                               <<04324>>25370000
<<set db to the absolute address requested and return the>>    <<04324>>25375000
<<old absolute address of db.                            >>    <<04324>>25380000
                                                               <<04324>>25385000
      begin                                                    <<04324>>25390000
      tos := newdb;                                            <<04324>>25395000
      asmb( xchd );                                            <<04324>>25400000
      changedb := tos;                                         <<04324>>25405000
      end                                                      <<04324>>25410000
    else                                                       <<04324>>25415000
                                                               <<04324>>25420000
<<return the data segment number the caller is at. >>          <<04324>>25425000
<<set db to an absolute location.                  >>          <<04324>>25430000
      begin                                                    <<04324>>25435000
                                                               <<04324>>25440000
<<return the data segment number the caller is at. >>          <<04324>>25445000
                                                               <<04324>>25450000
      changedb := double(-integer(dbxdsinfo.xdsdstfield));     <<06751>>25455000
                                                               <<04324>>25460000
<<mark that db is at an absolute location.         >>          <<04324>>25465000
                                                               <<04324>>25470000
      tos := dbxdsinfo;                                        <<06650>>25475000
      tos.absdbflag := true;                                   <<04324>>25480000
      dbxdsinfo := tos;                                        <<06650>>25485000
                                                               <<04324>>25490000
<<set db to an absolute location.                  >>          <<04324>>25495000
                                                               <<04324>>25500000
      tos := newdb;                                            <<04324>>25505000
      asmb( xchd );                                            <<04324>>25510000
      end                                                      <<04324>>25515000
    end;                                                       <<04324>>25520000
                                                               <<04324>>25525000
end; <<changedb>>                                              <<04324>>25530000
double  procedure mappedcsttophycst(mapcst,pcbpt);             <<06660>>25535000
   value mapcst, pcbpt;                                        <<06104>>25540000
   integer mapcst, pcbpt;                                      <<06104>>25545000
   option privileged, uncallable;                              <<06104>>25550000
   comment                                                     <<06104>>25555000
                                                               <<06104>>25560000
        input:                                                 <<06104>>25565000
                                                               <<06104>>25570000
           mapcst = code segment                               <<06104>>25575000
                    (0:1) = mapflag (ignored if no mapping     <<06104>>25580000
                                     firmware)                 <<06104>>25585000
                            =1 physically mapped               <<06104>>25590000
                               mapcst.(1:15) = physical        <<06104>>25595000
                               cst #                           <<06104>>25600000
                            =0 logical mapped mapcst.(8:8)     <<06104>>25605000
                               = logical cst #                 <<06104>>25610000
           pcbpt   = pcb index to use for mapping              <<06104>>25615000
                    = 0 use current pin                        <<06104>>25620000
                    <> 0 use specified pin                     <<06104>>25625000
                                                               <<06104>>25630000
        output:                                                <<06104>>25635000
                                                               <<06104>>25640000
           cce - valid conversion                              <<06104>>25645000
           ccl - invalid mapcst                                <<06104>>25650000
                                                               <<06104>>25655000
           mappedcsttophycst = physical cst # if               <<06104>>25660000
                               program cst then                <<06104>>25665000
                               return is in blklabel           <<06104>>25670000
                               form                            <<06104>>25675000
                                                               <<06104>>25680000
                                                               <<06104>>25685000
        note: this procedure should not be called in           <<06104>>25690000
              disabled or pdisabled mode to map mapcst         <<06104>>25695000
              for pin other than current pin.                  <<06104>>25700000
;                                                              <<06104>>25705000
begin                                                          <<06104>>25710000
                                                               <<*7564>>25715000
define                                                         <<*7564>>25720000
   physical'mapped = (mapcst < 0)#;                            <<*7564>>25725000
                                                               <<*7564>>25730000
   integer                                                     <<06104>>25735000
      pin,                                                     <<06104>>25740000
      inx,                                                     <<06104>>25745000
      nrpgmsegs,                                               <<06104>>25750000
      lsttdst,                                                 <<06104>>25755000
      dbsave := 0;                                             <<06660>>25760000
   logical                                                     <<06104>>25765000
      dbfixed := false;                                        <<06104>>25770000
   double                                                      <<06104>>25775000
      result = mappedcsttophycst,                              <<06660>>25780000
      savedb,                                                  <<06660>>25785000
      dbvalue;                                                 <<06104>>25790000
   integer array                                               <<06104>>25795000
      lstt(*) = db+0;                                          <<06104>>25800000
   logical array objresult(*)=result;                          <<06660>>25805000
   cc := cce;                                                  <<06104>>25810000
   if mapcst = 0 then                                          <<07320>>25815000
      begin                                                    <<07320>>25820000
      cc := ccl;                                               <<07320>>25825000
      return;                                                  <<07320>>25830000
      end;                                                     <<07320>>25835000
                                                               <<07320>>25840000
   if pcbpt = 0 then                                           <<06104>>25845000
      if curprc <> 0 then                                      <<06650>>25850000
         pcbpt := (curprc)                                     <<06650>>25855000
      else                                                     <<06104>>25860000
         if not physical'mapped then suddendeath(999);         <<*7564>>25865000
   pin := pcbpt/pcbsize;                                       <<06104>>25870000
                                                               <<06104>>25875000
   if mappingfirmware then                                     <<06104>>25880000
      begin                                                    <<06104>>25885000
      if mapcst < 0 then                                       <<06104>>25890000
         begin      << physically mapped >>                    <<06104>>25895000
         result := buildsegid( 1, mapcst.(8:8), pin);          <<06104>>25900000
         end                                                   <<06104>>25905000
      else                                                     <<06104>>25910000
         begin      << logically mapped >>                     <<06104>>25915000
         mapcst := mapcst.(8:8);                               <<06104>>25920000
         inx := spcbpbx;  << get cst block index >>            <<06104>>25925000
         pdisable;                                             <<06104>>25930000
         nrpgmsegs := dst(cstxblk(inx));                       <<06104>>25935000
         penable;                                              <<06104>>25940000
         if inx <> 0 and mapcst <= nrpgmsegs then              <<06104>>25945000
            begin     << program segment >>                    <<06104>>25950000
            result := buildsegid( 2, mapcst, pin);             <<06104>>25955000
            end                                                <<06104>>25960000
         else                                                  <<06104>>25965000
            begin     << sl segment >>                         <<06104>>25970000
            lsttdst := spcbmapdst;                             <<06104>>25975000
            if = then go nfg;                                  <<06104>>25980000
            if curprc = 0 then                                 <<06650>>25985000
               begin                                           <<06104>>25990000
               tos := dst( lsttdst*4+2);                       <<06104>>25995000
               tos := dst( x:=x+1);                            <<06104>>26000000
               assemble( xchd );                               <<06104>>26005000
               savedb := tos;                                  <<06104>>26010000
               end                                             <<06104>>26015000
            else                                               <<06104>>26020000
               begin                                           <<06104>>26025000
               if dbxdsinfo.absdbflag                          <<06650>>26030000
                  then                                                  26035000
                  begin                                        <<06104>>26040000
                  dbfixed := true;                             <<06104>>26045000
                  push( db );                                  <<06104>>26050000
                  dbvalue := tos;                              <<06104>>26055000
                  resetdb( -1 );                               <<06104>>26060000
                  end;                                         <<06104>>26065000
               dbsave := exchangedb(lsttdst) ;                 <<06660>>26070000
               end;                                            <<06104>>26075000
            if lstt = 0 or mapcst > lstt then go nfg;          <<06104>>26080000
            << get physical cst from lstt >>                   <<06104>>26085000
            result := double(lstt( mapcst&lsl(1)));            <<06660>>26090000
            result:=buildsegid(1,objresult(objidnumfield),pin);<<06660>>26095000
            go restore;                                        <<06104>>26100000
nfg:        cc := ccl;                                         <<06104>>26105000
restore:                                                       <<06104>>26110000
            << re-establish db environment >>                  <<06104>>26115000
            if curprc = 0 then                                 <<06650>>26120000
               begin                                           <<06104>>26125000
               tos := savedb;                                  <<06104>>26130000
               assemble( xchd );                               <<06104>>26135000
               end                                             <<06104>>26140000
            else                                               <<06104>>26145000
               begin                                           <<06104>>26150000
               dbsave := exchangedb( dbsave);                  <<06104>>26155000
               if dbfixed then                                 <<06104>>26160000
                  begin  << set absolute mode >>               <<06104>>26165000
                  setsysdb; << set abs bit in pcb >>           <<06104>>26170000
                  tos := dbvalue;                              <<06104>>26175000
                  set( db );                                   <<06104>>26180000
                  end;                                         <<06104>>26185000
               end;                                            <<06104>>26190000
            end;                                               <<06104>>26195000
         end;                                                  <<06104>>26200000
      end                                                      <<06104>>26205000
   else                                                        <<06104>>26210000
      begin         << no mapping firmware >>                  <<06104>>26215000
      mapcst := mapcst.(8:8);                                  <<06104>>26220000
      result := buildsegid( if mapcst < %300 then 1 else 2,    <<06104>>26225000
                            mapcst, pin);                      <<06104>>26230000
      end;                                                     <<06104>>26235000
end;  << mappedcsttophycst >>                                  <<06660>>26240000
logical procedure system( cstnum );                            <<06104>>26245000
   value cstnum;                                               <<06104>>26250000
   integer cstnum;                                             <<06104>>26255000
   option uncallable;                                          <<06282>>26260000
begin                                                          <<06104>>26265000
   <<   return true if mapcst is a system segment   >>         <<06104>>26270000
   <<   mapcst is of the form:                      >>         <<06104>>26275000
   <<                                               >>         <<06104>>26280000
   <<     mapcst.(0:1)   = mapflag                  >>         <<06104>>26285000
   <<     mapcst.(8:8)   = cst #                    >>         <<06104>>26290000
                                                               <<06104>>26295000
   double  seg;                                                <<06660>>26300000
   system:=false;                                              <<06660>>26305000
   seg := mappedcsttophycst( cstnum, 0);                       <<06660>>26310000
   if <> then return;      << invalid cst >>                   <<06660>>26315000
   pdisable;                                                   <<06104>>26320000
   system := dst(convsegidtostinx(seg)+1).systemflag;          <<06660>>26325000
   penable;                                                    <<06104>>26330000
end;   << system >>                                            <<06104>>26335000
integer procedure cstconv( seg, pcbpt);                        <<06104>>26340000
   value seg, pcbpt;                                           <<06104>>26345000
   integer seg, pcbpt;                                         <<06104>>26350000
   option privileged, uncallable;                              <<06104>>26355000
begin                                                          <<06104>>26360000
   double  clabel;                                             <<06660>>26365000
                                                               <<06104>>26370000
   clabel := mappedcsttophycst( seg, pcbpt );                  <<06104>>26375000
   if <> then return;                                          <<06104>>26380000
   cstconv := convsegidtostinx( clabel );                      <<06104>>26385000
end;    << cstconv >>                                          <<06104>>26390000
$page "MEMORY MANAGEMENT INTERFACING PROCEDURES : QUEUE ON SEGMENT"     26395000
procedure queueonobject(obj);                                  <<06660>>26400000
value obj;                                                     <<06660>>26405000
double  obj;                                                   <<06660>>26410000
option privileged,uncallable;                                           26415000
                                                                        26420000
comment                                                                 26425000
                                                                        26430000
queueonobject is called from absent trap handlers and other    <<06212>>26435000
places where the current process needs an object to be fetched <<06212>>26440000
main memory.  the process's memory                             <<06212>>26445000
request pointer in the sll is set to an sll entry for the segment       26450000
via a call to addtolocality. the process waits on a memory wait.        26455000
                                                                        26460000
;                                                                       26465000
                                                                        26470000
begin                                                                   26475000
integer pcbpt;                                                 <<06650>>26480000
entry queueonsegment; <<for backwards compatibility>>          <<06212>>26485000
logical array objident(*)=obj;                                 <<06660>>26490000
logical sllheadinx;     << sll pointer from pcb >>             <<06660>>26495000
integer array deltaq(*) = q-0;  <<for mmstat>>                 <<01571>>26500000
                                                                        26505000
queueonsegment :                                               <<06212>>26510000
                                                               <<06212>>26515000
pdisable;                                                               26520000
tos:=%1000d;                                                            26525000
asmb(xchd);                                                             26530000
pcbpt := curprc;                                               <<06650>>26535000
tos := sllptr;                                                 <<06650>>26540000
sllheadinx := s0;                                              <<06660>>26545000
tos:=obj;                                                      <<06660>>26550000
tos:=0;                                                                 26555000
tos.setmemreqptrflag:=1;                                                26560000
tos.setdeccntflag:=1; <<cause process to wait for object>>     <<07320>>26565000
addtolocality(*,*,*);                                                   26570000
mmstat'(mmstatqonobj,objident(objiddescfield),                 <<06948>>26575000
     objident(objidnumfield),sllheadinx,deltaq(-deltaq-1),0,0);<<06948>>26580000
asmb(xchd);                                                             26585000
if pcbpt <> 0 and                                               <<meas>>26590000
(gclassenabledmask.class0 or gclassenabledmask.class15) then    <<meas>>26595000
  meas'objfault(obj);  <<to update the meas. counters>>         <<meas>>26600000
<<stuff away reason stoped in pcbx of impeded process>>         <<meas>>26605000
<<done unconditionally for history for measurement inter.>>     <<meas>>26610000
tos := ics(-ics'stkbankcell);                                   <<meas>>26615000
tos := ics(-ics'stkbasecell);                                   <<meas>>26620000
tos := tos + sbtomeasstopreason;                                <<meas>>26625000
tos := stopsegfault; << temporary: should be logged to caching>><<meas>>26630000
asmb(ssea;ddel);                                                <<meas>>26635000
                                                                <<meas>>26640000
wait(memorywaitcode,memtrap);                                           26645000
end <<queueonobject>>;                                         <<06212>>26650000
$page "CONVERT EXTERNAL LABEL TO DELTA P"                      <<06212>>26655000
integer procedure convextlabeltodeltap(extlabel);                       26660000
value extlabel;                                                         26665000
integer extlabel;                                                       26670000
option privileged,uncallable;                                           26675000
                                                                        26680000
comment                                                                 26685000
                                                                        26690000
convextlabeltodeltap queues the calling process on the segment          26695000
indicated in the extlabel, and when the segment is present looks        26700000
up the deltap of the entry point in the segment's stt.                  26705000
                                                                        26710000
;                                                                       26715000
                                                                        26720000
begin                                                                   26725000
                                                                        26730000
double obj;                                                    <<06660>>26735000
logical array objident(*)=obj;                                 <<06660>>26740000
integer descstinx,                                             <<06660>>26745000
        sttnumber;                                             <<06104>>26750000
pdisable;                                                      <<06104>>26755000
sttnumber:=extlabel.(1:7);                                     <<06104>>26760000
obj:=mappedcsttophycst(extlabel,0);                            <<06660>>26765000
descstinx:=convsegidtostinx(obj);                              <<06660>>26770000
disable;                                                       <<06104>>26775000
if dst(descstinx) < 0 then  << seg absent >>                   <<06104>>26780000
   do                                                          <<06104>>26785000
      begin  <<ensure requested seg is present>>               <<06104>>26790000
         queueonobject(obj);                                   <<06660>>26795000
         pdisable;                                             <<06104>>26800000
         if objident(objidtypefield)=objidpgmtype then begin   <<06660>>26805000
            x:=objident(objidpbxfield);                        <<06660>>26810000
            descstinx:=cstxblk(x)+                             <<06660>>26815000
                          integer(objident(objidnumfield))*4;  <<06660>>26820000
      end end until not logical(dst(descstinx)).absentflag;    <<06660>>26825000
tos:=dst(x:=descstinx+2);                                               26830000
tos:=dst(x:=x+1);                                                       26835000
tos:=dst(x:=x-3).codesizefield&lsl(2)-1;                                26840000
asmb(ladd); <<addr of pl>>                                              26845000
tos:=tos-sttnumber;                                                     26850000
asmb(lsea);                                                             26855000
if mappingfirmware then                                        <<06104>>26860000
   tos.(1:1):=extlabel.(0:1)                                   <<06104>>26865000
else                                                           <<06104>>26870000
   tos.(1:1):=0;<<reset uncallable bit/set mapping flag>>      <<06104>>26875000
convextlabeltodeltap:=tos;                                              26880000
penable;                                                                26885000
end <<convextlabeltodeltap>>;                                           26890000
                                                                        26895000
$page "DEBUG BREAKPOINT SETTING PROCEDURE"                              26900000
                                                                        26905000
procedure setsegsbkpts(seg,     descstinx,bptinx);             <<06660>>26910000
value seg,descstinx,bptinx;                                    <<06660>>26915000
double  seg;                                                   <<06660>>26920000
integer          descstinx,bptinx;                             <<06660>>26925000
option privileged,uncallable;                                           26930000
                                                                        26935000
comment                                                        <<mm.iv>>26940000
                                                               <<mm.iv>>26945000
this procedure sets breakpoints in the specified segment.      <<mm.iv>>26950000
it must be called pdisabled.                                   <<mm.iv>>26955000
                                                               <<mm.iv>>26960000
    segident:  standard form of seg identifer                  <<01609>>26965000
    descstinx: dst relative index of seg                       <<01609>>26970000
    bptinx:    pcb extension index for the breakpoint table    <<01609>>26975000
                                                               <<mm.iv>>26980000
;                                                              <<mm.iv>>26985000
                                                               <<mm.iv>>26990000
begin                                                                   26995000
logical array segident(*)=seg;                                 <<06660>>27000000
integer limit;                                                 <<01609>>27005000
                                                                        27010000
<< check whether there are breakpoints to set >>               <<mm.iv>>27015000
if bptinx = 0 or                                               <<mm.iv>>27020000
   bptinx = sys'bkpt'ext'x and not sys'bkpt                    <<mm.iv>>27025000
then return;                                                   <<mm.iv>>27030000
<< xchdb to breakpoint table   >>                              <<mm.iv>>27035000
<< table better be present     >>                              <<mm.iv>>27040000
if not bpt'tab'locked then suddendeath (199);                  <<mm.iv>>27045000
tos := dst(bpt'dst'ind + 2);                                   <<mm.iv>>27050000
tos := dst(x+1);                                               <<mm.iv>>27055000
asmb( xchd );                                                  <<mm.iv>>27060000
bptinx := bpt(bptinx);  << get 1st link >>                     <<mm.iv>>27065000
while bptinx <> 0 do                                           <<mm.iv>>27070000
   begin                                                                27075000
   if bpt(bptinx).bkpt'updating=0 and                          <<06104>>27080000
      bpt(bptinx+clabeloffset)=integer(segident(0)) and        <<06660>>27085000
      bpt(bptinx+clabeloffset+1)=integer(segident(1))          <<06660>>27090000
   then                                                        <<06660>>27095000
      begin                                                             27100000
      tos:=bpt(bptinx);                                        <<06104>>27105000
      asmb(del);                                                        27110000
      if >= then                                                        27115000
         begin                                                          27120000
         tos:=dst(x:=descstinx+2);                                      27125000
         tos:=dst(x:=x+1);                                              27130000
         tos:=tos+bpt(bptinx+plocoffset); <<delta p>>          <<06104>>27135000
         asmb(lsea);                                                    27140000
         if  tos <> %36000  then                                        27145000
            begin  << save instruction >>                               27150000
            bpt(x:=bptinx).bkpt'valid:=1;                      <<06104>>27155000
            asmb(lsea);                                                 27160000
            bpt(x:=x+instroffset):=tos;                        <<06104>>27165000
            tos:=%36000;                                                27170000
            asmb(ssea);                                                 27175000
            end;                                                        27180000
         ddel;                                                          27185000
         end;                                                           27190000
      end;                                                              27195000
   bptinx:=bpt(bptinx+linkoffset);                             <<06104>>27200000
   end;                                                                 27205000
asmb( xchd ); ddel;          <<restore db>>                    <<mm.iv>>27210000
end  <<setsegsbkpts>>;                                                  27215000
                                                                        27220000
$page "KERNEL UTILITY PROCEDURES : GET DATA SEG CHANGE STATE"           27225000
procedure getdatasegchangestate(segnum);                                27230000
value segnum;                                                           27235000
integer segnum;                                                         27240000
option privileged,uncallable;                                           27245000
                                                                        27250000
comment                                                                 27255000
                                                                        27260000
called from dlsize,zsize,pxfilesize to clear ongoing i/os               27265000
flag absent, pdisable.also from the stackoverflow interrupt handler.    27270000
                                                                        27275000
;                                                                       27280000
                                                                        27285000
begin                                                                   27290000
                                                                        27295000
if logical(dst(x:=segnum&lsl(2)+1)).segresidentflag then                27300000
   cc:=ccl else                                                         27305000
   begin                                                                27310000
   tos:=dst(x:=x+1);                                                    27315000
   tos:=dst(x:=x+1);                                                    27320000
   tos:=tos+rbtorasdisp;                                                27325000
   disable;                                                    <<01770>>27330000
   pdisable;                                                   <<01770>>27335000
   asmb(lsea);                                                          27340000
   asmb(tbc regfzbit);                                                  27345000
   if <> then                                                  <<02060>>27350000
      begin                                                    <<02060>>27355000
      cc := ccl;                                               <<02060>>27360000
      penable;                                                 <<02060>>27365000
      end                                                      <<02060>>27370000
   else                                                        <<02060>>27375000
      begin                                                             27380000
      asmb(tbc reglkdbit);                                              27385000
      if <> then                                               <<02060>>27390000
         begin                                                 <<02060>>27395000
         cc := ccl;                                            <<02060>>27400000
         penable;                                              <<02060>>27405000
         end                                                   <<02060>>27410000
      else                                                     <<02060>>27415000
         begin                                                          27420000
         asmb(tbc regiofzbit);                                          27425000
         if <> then                                                     27430000
            begin                                                       27435000
            tos.sizechangepndgflag:=1;                                  27440000
            asmb(ssea);                                                 27445000
            tos:=tos+rastompqlinkdisp;                         <<06660>>27450000
            tos := curprc;                                     <<06650>>27455000
            asmb(ssea);                                                 27460000
            impede(0);                                                  27465000
            cc:=ccg;                                                    27470000
            end                                                         27475000
        else                                                            27480000
            begin                                                       27485000
            dst(x:=segnum&lsl(2)).absentflag:=1;                        27490000
            cc:=cce;                                                    27495000
            end;                                                        27500000
         end;                                                           27505000
      end;                                                              27510000
   end;                                                                 27515000
end  <<getdatasegchangestate(segnum)>>;                                 27520000
$page "KERNEL UTILITY PROCEDURES : FLAG PROCESS ABSENT"                 27525000
                                                                        27530000
procedure flagprocabsent(pin,obj,specialinst);                 <<06660>>27535000
value pin,obj,specialinst;                                     <<06660>>27540000
integer pin;                                                   <<06660>>27545000
double obj;                                                    <<06660>>27550000
logical specialinst;                                           <<06411>>27555000
option privileged,uncallable;                                  <<06411>>27560000
                                                               <<06411>>27565000
comment                                                        <<06411>>27570000
                                                               <<06411>>27575000
flagprocabsent places the specified process into an absent     <<06411>>27580000
state so that the dispatcher will invoke the memory manager    <<06411>>27585000
on behalf of the process.                                      <<06411>>27590000
                                                               <<06411>>27595000
the special instruction parameter indicates whether a full     <<06411>>27600000
swap from scratch should be induced, and whether a specified   <<06411>>27605000
object should be added to the process' locality and the        <<06411>>27610000
process' mem req ptr in the sll pointed at the object's        <<06411>>27615000
sll entry.                                                     <<06411>>27620000
                                                               <<06411>>27625000
if the specified process is the currently executing process,   <<06411>>27630000
a disp is issued.                                              <<06411>>27635000
                                                               <<06411>>27640000
this procedure is called when an element of the process'       <<06411>>27645000
minimal locality is missing when it's needed.  this happens    <<06411>>27650000
at launch time (stack or extra data segment consumed by        <<06411>>27655000
replacment algorithm), on buffer traps for disc i/o, and       <<06411>>27660000
on attempted disc cache moves.                                 <<06411>>27665000
                                                               <<06411>>27670000
it is assumed that db is at sysdb when invoked.                <<06411>>27675000
                                                               <<06411>>27680000
;                                                              <<06411>>27685000
                                                               <<06411>>27690000
begin                                                          <<06411>>27695000
logical array objident(*)=obj;                                 <<06660>>27700000
integer pcbpt,                                                 <<06650>>27705000
        sllheadinx,    << index to sll header entry >>         <<06625>>27710000
        addflags;                                              <<06411>>27715000
                                                               <<06411>>27720000
pcbpt := pin * pcbsize;                                        <<06650>>27725000
                                                               <<06411>>27730000
<<mark process absent, requiring scheduling attention>>        <<06411>>27735000
                                                               <<06411>>27740000
disable;                                                       <<06411>>27745000
resabortinfo.sarflag := 1;                                     <<06650>>27750000
wakemask.memorywaitflag := 1;                                  <<06650>>27755000
sllheadinx := sllptr;                                          <<07320>>27760000
                                                               <<06411>>27765000
<<if a full swap required, set it up>>                         <<06411>>27770000
                                                               <<06411>>27775000
if specialinst.causefullswap then                              <<06411>>27780000
   begin <<set swap required, start swap over in sll header>>  <<06411>>27785000
   sll(schedtoiomsg).sllstartoverflag := 1;                    <<06625>>27790000
   sll(schedtoiomsg).sllswapreqflag := 1;                      <<06625>>27795000
   end;                                                        <<06411>>27800000
                                                               <<06411>>27805000
<<if a specific object should be swapped in, add it to loc>>   <<06411>>27810000
                                                               <<06411>>27815000
if specialinst.fetchspecobj then                               <<06411>>27820000
   begin <<add to loc, set mem req ptr>>                       <<06411>>27825000
   addflags:=0;                                                <<06411>>27830000
   addflags.setmemreqptrflag :=1;                              <<06411>>27835000
   addflags.setdeccntflag := 1;                                <<07320>>27840000
   if curprc = 0 then addflags.noimpede := 1;                  <<*7822>>27845000
   addtolocality(sllheadinx,obj,addflags);                     <<06660>>27850000
   if > then suddendeath(602);  << no more sll entries >>      <<*7822>>27855000
   end;                                                        <<*7822>>27860000
                                                               <<06411>>27865000
<<do a disp if current process>>                               <<06411>>27870000
                                                               <<06411>>27875000
if pcbpt = (curprc) then                                        <<meas>>27880000
   begin                                                        <<meas>>27885000
   if gclassenabledmask.class0 or gclassenabledmask.class15 then<<meas>>27890000
      meas'objfault(obj);  <<to update the meas. counters>>     <<meas>>27895000
                                                                <<meas>>27900000
   <<stuff away reason stoped in pcbx of impeded process>>      <<meas>>27905000
   <<done unconditionally for history for measurement inter.>>  <<meas>>27910000
   tos := ics(-ics'stkbankcell);                                <<meas>>27915000
   tos := ics(-ics'stkbasecell);                                <<meas>>27920000
   tos := tos + sbtomeasstopreason;                             <<meas>>27925000
                                                               <<06411>>27930000
      tos := stopsegfault; <<temporary until cache counter added  meas>>27935000
   asmb(ssea;ddel);                                             <<meas>>27940000
                                                                <<meas>>27945000
   asmb(disp);                                                  <<meas>>27950000
   end;                                                         <<meas>>27955000
end; <<flagprocabsent>>                                        <<06411>>27960000
                                                               <<06411>>27965000
$title "KERNEL UTILITY PROCEDURES : GENERATE SPECIAL REQUEST"           27970000
procedure genspecreq(objident,newsize,readdisp,movelength);    <<06620>>27975000
value objident,newsize,readdisp,movelength;                    <<06620>>27980000
integer newsize,readdisp,movelength;                           <<06620>>27985000
double objident;                                               <<06620>>27990000
option privileged,uncallable;                                           27995000
                                                                        28000000
comment                                                                 28005000
                                                                        28010000
used for buffering the information required to effect a size change     28015000
for data segments and any internal pcbx moves.                          28020000
                                                                        28025000
an entry from the special request table is obtained, filled in          28030000
with the passed information, and linked to the head of the              28035000
queue of pending requests.                                              28040000
                                                                        28045000
;                                                                       28050000
                                                                        28055000
begin                                                                   28060000
                                                                        28065000
double savedb;                                                          28070000
                                                                        28075000
integer entryindex;                                                     28080000
                                                                        28085000
disable;                                                                28090000
tos:=%1000d;                                                            28095000
asmb(xchd);                                                             28100000
savedb:=tos;                                                            28105000
entryindex := getsystabentry(specreqdst,false,true);           <<06616>>28110000
if entryindex=0 then suddendeath(600);   <<spec req tab conftoo small>> 28115000
                                                                        28120000
<<link to head of special req q>>                                       28125000
                                                                        28130000
tos:=specqhead;                                                         28135000
specqhead:=entryindex;                                                  28140000
                                                                        28145000
<<fill in entry>>                                                       28150000
tos := dst(specreqdst&lsl(2) + 2); << bank >>                  <<06616>>28155000
tos := dst(x + 1);                                             <<06616>>28160000
asmb(xchd);                                                    <<06616>>28165000
ddel;                                                          <<06616>>28170000
                                                                        28175000
x:=entryindex;                                                          28180000
entryword00:=tos;   <<attach rest of queue>>                            28185000
entryword03 := newsize;                                        <<06620>>28190000
entryword04 := readdisp;                                       <<06620>>28195000
entryword05 := movelength;                                     <<06620>>28200000
x := x & lsr(1);      << need an index for a double array >>   <<06620>>28205000
dentryword01 := objident;                                      <<06620>>28210000
tos:=savedb;                                                            28215000
asmb(xchd);                                                             28220000
end  <<genspecreq>> ;                                                   28225000
                                                                        28230000
procedure clearwws;                                                     28235000
option privileged,uncallable;                                           28240000
                                                                        28245000
comment                                                                 28250000
calls to this procedure should be eliminated.                           28255000
;                                                                       28260000
                                                                        28265000
begin                                                                   28270000
integer pcbpt;                                                 <<06650>>28275000
disable;                                                                28280000
pcbpt := curprc;                                               <<06650>>28285000
eventflags.wws := 0;                                           <<06650>>28290000
end   <<procedure clearwws>>;                                           28295000
$page "I/O INTERFACE PROCEDURES : AWAKE DEVICE"                         28300000
procedure awakedevice(ioqinx,obj,iostatus);                    <<06660>>28305000
value ioqinx,obj,iostatus;                                     <<06660>>28310000
integer ioqinx,iostatus;                                       <<06392>>28315000
double  obj;                                                   <<06660>>28320000
option privileged,uncallable;                                           28325000
                                                                        28330000
comment                                                                 28335000
                                                                        28340000
awakedevice is called to give info on the completion of a               28345000
segment fetch request to an i/o device monitor.  the device             28350000
monitor is awakened through a call to awakeio.                          28355000
                                                                        28360000
the ioqinx parameter carries either a drq or ioq table index   <<*7567>>28365000
only for data segment requests.  for drivers, this parameter   <<01770>>28370000
actually carries the ldev number.  this change was required    <<01770>>28375000
since interrupts requiring the startup of an idle channel      <<01770>>28380000
program have no associated i/o requests.                       <<01770>>28385000
if the ioqinx is negative, this is an unblocked                <<07320>>28390000
makepresent for a port procedure running on the ics.  this     <<06947>>28395000
assume that the ioq table lies in the first 32k of of sysglob. <<06947>>28400000
                                                               <<*7567>>28405000
if ioqinx.(1:1) is set, then this is a drq relative index.     <<*7567>>28410000
                                                               <<*7567>>28415000
                                                               <<01770>>28420000
;                                                                       28425000
                                                                        28430000
begin                                                                   28435000
integer pointer ditpointer;                                             28440000
integer ditsysdbinx,                                                    28445000
        ioq'entry'index,                                       <<06392>>28450000
        drq'entry'index,                                       <<*7567>>28455000
        ldevnumber;                                                     28460000
                                                               <<*7567>>28465000
logical adisc := false;                                        <<*7567>>28470000
                                                               <<*7567>>28475000
logical array objident(*)=obj;                                 <<06660>>28480000
if ioqinx < 0 then                                             <<*7567>>28485000
  begin  << port segment makepresent >>                        <<06947>>28490000
  portseg'completor(ioqinx);                                   <<06947>>28495000
  return;                                                      <<06947>>28500000
  end;                                                         <<06947>>28505000
                                                               <<06947>>28510000
if logical (ioqinx.(1:1)) then                                 <<*7567>>28515000
   begin                                                       <<*7567>>28520000
   adisc := true;                                              <<*7567>>28525000
   drq'entry'index := ioqinx.(2:14);                           <<*7567>>28530000
   end                                                         <<*7567>>28535000
else ioq'entry'index := ioqinx;                                <<*7567>>28540000
                                                               <<*7567>>28545000
if objident(objidtypefield)<>objiddatatype                     <<06660>>28550000
   then ldevnumber := ioqinx                                   <<*7567>>28555000
else                                                           <<*7567>>28560000
   begin                                                       <<*7567>>28565000
   ldevnumber := if adisc then drq'ldev else ioq'ldev;         <<*7567>>28570000
   end;                                                        <<*7567>>28575000
                                                               <<*7567>>28580000
tos := lpdt(x := ldevnumber&lsl(2)+lpdt'ditp);                 <<06675>>28585000
ditsysdbinx:=s0;                                                        28590000
@ditpointer := tos;                                            <<*7567>>28595000
mmstat'(mmstatawakedev,ditsysdbinx,mem(ditsysdbinx),ioqinx,    <<06948>>28600000
       0,0,0);                                                 <<06948>>28605000
if objident(objidtypefield)<>objiddatatype then                <<06660>>28610000
   begin <<a driver>>                                                   28615000
   x := ditsysdbinx;                                           <<07320>>28620000
   x:=ditdltp;                                                          28625000
   tos:=dltflags;                                                       28630000
   if iostatus<>iostatusok then tos.dltmmerrorcflag:=1         <<06212>>28635000
   else tos.dltdrvrfrznflag:=1;                                         28640000
   dltflags:=tos;                                                       28645000
   end                                                                  28650000
else                                                                    28655000
   begin <<a buffer>>                                                   28660000
   if iostatus<>iostatusok then                                <<*7567>>28665000
      begin                                                    <<*7567>>28670000
      if adisc then drq'mamerr := 1 else ioq'mamerr := 1;      <<*7567>>28675000
      end                                                      <<*7567>>28680000
   else                                                        <<*7567>>28685000
      begin                                                    <<*7567>>28690000
      if adisc then drq'datafrzn := 1 else ioq'datafrzn := 1;  <<*7567>>28695000
      end;                                                     <<*7567>>28700000
                                                               <<*7567>>28705000
   end;                                                                 28710000
awakeio(ditpointer,0);                                                  28715000
end  <<awakedevice>>;                                                   28720000
$page "I/O INTERFACE PROCEDURES : UNDEFER OBJECTS MP Q"        <<06212>>28725000
                                                                        28730000
procedure undeferobjsmpq(regionbase,objident,iostatus);        <<06212>>28735000
value regionbase,objident,iostatus;                            <<06212>>28740000
double regionbase,objident;                                    <<06660>>28745000
integer iostatus;                                              <<06212>>28750000
option privileged,uncallable;                                           28755000
                                                                        28760000
begin                                                                   28765000
                                                                        28770000
double                                                         <<06620>>28775000
   sll'objid,      << complete object identifier from sll >>   <<06660>>28780000
   savedb,           << db at entry/exit >>                    <<06620>>28785000
   sr'tabledb;       << db when at special request table >>    <<06620>>28790000
                                                               <<06620>>28795000
integer                                                        <<06620>>28800000
   deferredpcbpt,                                              <<06620>>28805000
   entryinx,      << current spec. req. table entry >>         <<06620>>28810000
   i,                                                          <<06620>>28815000
   next'entry,    << next linked entry if 1st full >>          <<06625>>28820000
   sllheadinx,    << index for header entry of sll >>          <<06625>>28825000
   sllinx,        << index for regular entry of sll >>         <<06625>>28830000
   nextpin;                                                    <<06625>>28835000
                                                                        28840000
<<undefer processes waiting for this object>>                <<<<06212>>28845000
                                                                        28850000
tos:=regionbase;                                                        28855000
tos:=tos+rbtompqlinkdisp;                                               28860000
asmb(lsea);                                                             28865000
while <> do                                                             28870000
   begin                                                                28875000
   deferredpcbpt := s0;                                        <<06660>>28880000
   x:=tos+sllixwordnum;                                                 28885000
   sllheadinx := pcb(x);                                       <<06625>>28890000
   sllinx := sll(firstinx);                                    <<06625>>28895000
   tos := sll(sll'objdesc);                                    <<06660>>28900000
   tos := sll(sll'objnum);                                     <<06660>>28905000
   sll'objid := tos;                                           <<06660>>28910000
                                                               <<06660>>28915000
   while sll'objid <> objident do                              <<06660>>28920000
      begin                                                    <<06660>>28925000
      sllinx := sll(nextinx);                                  <<06660>>28930000
      if sllinx = 0 then suddendeath(612);                     <<06660>>28935000
      tos := sll(sll'objdesc);                                 <<06660>>28940000
      tos := sll(sll'objnum);                                  <<06660>>28945000
      sll'objid := tos;                                        <<06660>>28950000
      end;                                                     <<06660>>28955000
                                                               <<06660>>28960000
                                                               <<06625>>28965000
   sll(sll'flags).sllimiflag := 0;                             <<06625>>28970000
   nextpin := sll(nextimppin);                                 <<06625>>28975000
   sll(nextimppin) := 0;                                       <<07320>>28980000
   if iostatus <> iostatusok then abortprocess(deferredpcbpt   <<06650>>28985000
                          ,makepresioerr) else                 <<06650>>28990000
   if sll(sll'flags).slldeccntflag = 1 then                    <<06625>>28995000
      begin <<dec procs count of i/o comp to awake>>                    29000000
      sll(sll'flags).slldeccntflag := 0;                       <<06945>>29005000
      tos := sll(schedtoiomsg).slliocomptoawakecnt - 1;        <<06625>>29010000
      sll(schedtoiomsg).slliocomptoawakecnt := s0;             <<06625>>29015000
      asmb(test,del);                                                   29020000
      if < then suddendeath(612);                              <<01644>>29025000
      if = then                                                         29030000
         begin <<process is being swapped in or is ready for launch>>   29035000
         if not sll(schedtoiomsg).sllswapipflag                <<06625>>29040000
         then awake(deferredpcbpt,memorywaitcode,nowait);               29045000
         end;                                                           29050000
      end;                                                              29055000
   tos:=nextpin;                                               <<06411>>29060000
   end;                                                                 29065000
                                                                        29070000
<<                                                                      29075000
awakeio on devices queued for this segment                              29080000
>>                                                                      29085000
                                                                        29090000
tos:=regionbase;                                                        29095000
tos:=tos+rbtocompmsgdisp;                                               29100000
asmb(lsea);                                                             29105000
asmb(tbc compmsgiowakebit);                                             29110000
if <> then                                                              29115000
   begin  <<devices waiting for segment>>                               29120000
   asmb(del);                                                           29125000
   tos:=tos+compmsgtoioreqqdisp;                                        29130000
   asmb(lsea);                                                          29135000
   if = then suddendeath(612);                                 <<01644>>29140000
   entryinx := tos;                                            <<06616>>29145000
   tos := dst(specreqdst & lsl(2) + 2);    << bank >>          <<06620>>29150000
   tos := dst(x := x+1);                   << address >>       <<06620>>29155000
   asmb(xchd);                                                 <<06620>>29160000
   savedb := tos;                                              <<06620>>29165000
                                                               <<06620>>29170000
   while entryinx <> 0 do                                      <<06620>>29175000
      begin                                                    <<06620>>29180000
      next'entry := systabentry(entryinx);                     <<06620>>29185000
      i := 1;                                                  <<06620>>29190000
      while systabentry(x := entryinx + i) <> 0 and i <= 5 do  <<06620>>29195000
         begin                                                 <<06620>>29200000
         tos := systabentry(x);  << ioqinx >>                  <<06620>>29205000
         tos := savedb;                                        <<06620>>29210000
         asmb(xchd);                                           <<06620>>29215000
         sr'tabledb := tos;                                    <<06620>>29220000
                                                               <<06620>>29225000
         awakedevice(*,objident,iostatus);                     <<06620>>29230000
                                                               <<06620>>29235000
         tos := sr'tabledb;                                    <<06620>>29240000
         asmb(xchd);                                           <<06620>>29245000
         savedb := tos;                                        <<06620>>29250000
                                                               <<06620>>29255000
         i := i + 1;                                           <<06620>>29260000
         end;                                                  <<06620>>29265000
                                                               <<06620>>29270000
      relsystabentry(specreqdst,entryinx);                     <<06620>>29275000
      disable;                                                 <<06620>>29280000
      entryinx := next'entry;     << ready to undefer entry >> <<06620>>29285000
      enable;                                                  <<06620>>29290000
      end;                                                     <<06620>>29295000
                                                               <<06620>>29300000
   tos := savedb;                                              <<06620>>29305000
   asmb(xchd);                                                 <<06620>>29310000
   ddel;                                                       <<06620>>29315000
   end;                                                        <<06620>>29320000
end  <<procedure undeferobjsmpq>>;                             <<06212>>29325000
                                                               <<06212>>29330000
$page "I/O SYSTEM INTERFACE PROCEDURES"                                 29335000
procedure iofreeze'(obj);                                      <<06660>>29340000
value obj;                                                     <<06660>>29345000
double  obj;                                                   <<06660>>29350000
option privileged,uncallable;                                           29355000
                                                                        29360000
comment                                                                 29365000
                                                                        29370000
iofreeze' is called from i/o system monitors to freeze' a               29375000
segment in memory so that instruction fetch and data                    29380000
transfer by dma i/o system devices may take place.  if                  29385000
the required segment is present, the segment gets io frozen             29390000
if it is absent, status through the condition code is returned          29395000
and nothing is done.  the monitor must make a special                   29400000
request for the segment to the scheduler, since blocking                29405000
the monitor on the ics in iofreeze' wouldn't work.                      29410000
                                                                        29415000
;                                                                       29420000
                                                                        29425000
begin                                                                   29430000
integer newiofzcnt,                                                     29435000
        descstinx;                                                      29440000
integer condcode:=cce;                                                  29445000
integer type := 0;      << for mmstat' >>                      <<*7564>>29450000
logical freeze':=true;                                                  29455000
logical array objident(*)=obj;                                 <<06660>>29460000
entry iounfreeze';                                                      29465000
                                                                        29470000
type.(12:4) := 0;    <<type for iofreeze>>                     <<01571>>29475000
go over;                                                                29480000
iounfreeze':freeze':=false;                                             29485000
type.(12:4) := 3;    <<type for iounfreeze>>                   <<01571>>29490000
over:                                                                   29495000
if objident(objidtypefield)=objiddatatype                      <<06660>>29500000
then descstinx:=objident(objidnumfield)&lsl(2)                 <<06660>>29505000
else descstinx:=convsegidtostinx(obj);                         <<06660>>29510000
x:=descstinx;                                                           29515000
disable;                                                                29520000
tos:=dst(x);                                                            29525000
asmb(del);                                                              29530000
if < then condcode:=ccl  <<segment absent>> else                        29535000
   begin  <<segment is present>>                                        29540000
   tos:=dst(x:=x+1);                                                    29545000
   asmb(tbc segresidentbit);                                            29550000
   if = then                                                            29555000
      begin <<seg not core resident>>                                   29560000
      tos:=dst(x:=x+1);                                                 29565000
      tos:=dst(x:=x+1);                                                 29570000
      tos:=tos+rbtowdiofzcntdisp;                                       29575000
      asmb(lsea);                                                       29580000
      if freeze' then                                                   29585000
         begin                                                          29590000
         newiofzcnt:=s0.iofzcntfield+1;                                 29595000
         tos.iofzcntfield:=newiofzcnt;                                  29600000
         asmb(ssea);                                                    29605000
         tos:=tos+wdiofzcnttorasdisp;                                   29610000
         asmb(lsea);                                                    29615000
         tos.regiofzflag:=1;                                            29620000
         asmb(ssea);                                                    29625000
         end                                                            29630000
      else                                                              29635000
         begin  <<unfreeze'>>                                           29640000
         newiofzcnt:=s0.iofzcntfield-1;                                 29645000
         tos.iofzcntfield:=newiofzcnt;                                  29650000
         asmb(ssea);                                                    29655000
         tos:=tos+wdiofzcnttorasdisp;                                   29660000
         asmb(lsea);                                                    29665000
         tos.regiofzflag:=0;                                            29670000
         if = then condcode:=ccl; <<reg wasn't i/o frozen>>             29675000
         if newiofzcnt = 0 then                                         29680000
            begin                                                       29685000
            tos.sizechangepndgflag:=0;                                  29690000
            asmb(ssea);                                                 29695000
            if <> then                                                  29700000
               begin                                                    29705000
               tos := tos + rastompqlinkdisp;                  <<06660>>29710000
               asmb(lsea);                                              29715000
               unimpede(*);                                             29720000
               end;                                                     29725000
            end;                                                        29730000
         end;                                                           29735000
      end;                                                              29740000
   end;                                                                 29745000
cc:=condcode;                                                           29750000
mmstat'(mmstatspecreq,objident(objiddescfield),                <<06948>>29755000
       objident(objidnumfield),type,newiofzcnt,0,0);           <<06948>>29760000
end  <<iofreeze'>>;                                                     29765000
$page "I/O INTERFACE PROCEDURES : TEST I/O FROZEN"                      29770000
logical procedure testiofrozen(obj);                           <<06660>>29775000
value obj;                                                     <<06660>>29780000
double  obj;                                                   <<06660>>29785000
option privileged,uncallable;                                           29790000
                                                                        29795000
comment                                                                 29800000
                                                                        29805000
used by cs to see if a driver has already been frozen. for performance. 29810000
;                                                                       29815000
                                                                        29820000
begin                                                                   29825000
                                                                        29830000
integer descstinx;                                                      29835000
descstinx:=convsegidtostinx(obj);                              <<06660>>29840000
disable;                                                                29845000
tos:=dst(x:=descstinx);                                                 29850000
asmb(del);                                                              29855000
if > then                                                               29860000
   begin  <<segment is present>>                                        29865000
   tos:=dst(x:=x+1);                                                    29870000
   asmb(tbc segresidentbit);                                            29875000
   if <> then testiofrozen:=true else                                   29880000
      begin <<not resident>>                                            29885000
      tos:=dst(x:=x+1);                                                 29890000
      tos:=dst(x:=x+1);                                                 29895000
      tos:=tos+rbtorasdisp;                                             29900000
      asmb(lsea);                                                       29905000
      tos.regiofzflag:=0;                                               29910000
      if <> then testiofrozen:=true;                                    29915000
      end;                                                              29920000
   end;                                                                 29925000
end  <<testiofrozen>>;                                                  29930000
$page "I/O INTERFACING PROCEDURES : FETCHIOSEG"                         29935000
procedure fetchioseg(obj,ldev,ioreqinx,flags);                 <<*7567>>29940000
value obj,ldev,ioreqinx,flags;                                 <<*7567>>29945000
double  obj;                                                   <<06660>>29950000
integer       ldev,ioreqinx,flags;                             <<*7567>>29955000
option privileged,uncallable;                                           29960000
                                                                        29965000
comment                                                                 29970000
                                                                        29975000
fetchioseg is used by i/o system monitors to request segments on        29980000
behalf of devices.  this interface allows the caller to request         29985000
a driver or buffer data segment in an unblocked manner.  when the       29990000
segment arrives, it is iofrozen if this had been requested, and         29995000
awakeio is called on the appropriate device. also, the data frozen      30000000
bit in the specified i/o request flags word is set for data segment     30005000
requests, and the driver frozen bit in the ilt is set for driver        30010000
fetch requests.                                                         30015000
                                                                        30020000
parameter specification :                                               30025000
                                                                        30030000
   obj : standard object identifier format.                    <<*7567>>30035000
                                                                        30040000
   ldev : logical device number of device requiring segment             30045000
                                                                        30050000
   ioreqinx : table relative index of ioq or drq request       <<*7567>>30055000
              element associated with the segment fetch        <<*7567>>30060000
              request (only required for data segment fetch    <<*7567>>30065000
              requests).                                       <<*7567>>30070000
              bit (1:1) = 1 then this is a drq.                <<*7567>>30075000
                                                                        30080000
   flags : .(0:1) = 1 ==> iofreeze segment when it arrives              30085000
                                                                        30090000
condition code return specification :                                   30095000
                                                                        30100000
   return cc = cce ==> segment is present, and has been i/o frozen      30105000
                       if so requested (but data frozen, driver frozen  30110000
                       bits not set, awakeio not called)                30115000
             = ccg ==> segment not around, and request for segment      30120000
                       has been issued.                                 30125000
;                                                                       30130000
                                                                        30135000
begin                                                          <<jbiv>> 30140000
logical array objid(*)=obj;                                    <<06660>>30145000
integer segdescstinx;                                                   30150000
                                                                        30155000
                                                               <<jbiv>> 30160000
segdescstinx:=convsegidtostinx(obj);                           <<06660>>30165000
if < then suddendeath(624);  << segment is not allocated>>     <<04643>>30170000
disable;                                                       <<jbiv>> 30175000
if not logical(dst(segdescstinx)).absentflag then              <<jbiv>> 30180000
   begin  <<seg is around>>                                    <<jbiv>> 30185000
   cc:=cce;                                                    <<jbiv>> 30190000
   if logical(flags).msgiofzreqflag then iofreeze'(obj);       <<06660>>30195000
   end                                                         <<jbiv>> 30200000
else                                                           <<jbiv>> 30205000
   begin <<must send off a request for the segment>>           <<jbiv>> 30210000
   cc:=ccg;                                                    <<jbiv>> 30215000
   tos:=obj;                                                   <<06660>>30220000
   if objid(objidtypefield)<> objiddatatype then tos:=ldev     <<06660>>30225000
   else tos:=ioreqinx;                                         <<*7567>>30230000
   tos:=flags;                                                 <<jbiv>> 30235000
   sendmsg(schedpin,iosegreqport,4,0);                         <<06660>>30240000
   end;                                                        <<jbiv>> 30245000
end <<fetchioseg>>;                                            <<jbiv>> 30250000
                                                               <<jbiv>> 30255000
                                                                        30260000
$page "I/O INTERFACE PROCEDURES : CHECK FOR DEFERRED DISC REQ" <<06212>>30265000
                                                                        30270000
procedure checkfordeferreddiscreq(obj);                        <<06660>>30275000
value obj;                                                     <<06660>>30280000
double  obj;                                                   <<06660>>30285000
option privileged,uncallable;                                           30290000
                                                                        30295000
comment                                                                 30300000
                                                               <<06212>>30305000
checkfordeferreddiscreq scans the list of deferred discrequests<<06212>>30310000
searching for requests which involve this object.              <<06212>>30315000
                                                               <<06212>>30320000
for any deferred physical requests involving this segment,     <<06212>>30325000
the disc request is removed from the deferred queue and inserte<<06212>>30330000
into the active disc request queue attached to the device's dit<<06212>>30335000
                                                               <<06212>>30340000
for logical requests (fulfilled via move with cached disc domai<<06212>>30345000
involving this segment, the related logical disc request elemen<<06212>>30350000
is removed from the deferredqueue and reinserted into the pendi<<06212>>30355000
queue attached to the cdt entry mapping the disc domain        <<06212>>30360000
involved in the trasfer.  a message is sent to the dispatcher  <<06212>>30365000
to try the move between the segment and the mapped disc domain.<<06212>>30370000
this could be needed due to garbage collection of a data segmen<<06212>>30375000
during which the mapped domain involved in a logical xfer      <<06212>>30380000
arrives.                                                       <<06212>>30385000
                                                               <<06212>>30390000
                                                               <<06212>>30395000
;                                                                       30400000
                                                                        30405000
begin                                                                   30410000
logical array objident(*)=obj;                                 <<06660>>30415000
integer next,                                                           30420000
        sllheadinx,                                            <<*8400>>30425000
        drq'entry'index,                                       <<06392>>30430000
        reqp;                                                           30435000
define ldr'entry'index = drq'entry'index#;                     <<06941>>30440000
                                                                        30445000
<<head of deferred phys queue is located in the header entry>> <<06212>>30450000
<<of the disc request table>>                                  <<06212>>30455000
                                                               <<06212>>30460000
                                                               <<06212>>30465000
disable;                                                       <<06212>>30470000
                                                               <<06212>>30475000
drq'entry'index:=dqh'disahead;      <<head of deferred queue>> <<06392>>30480000
                                                                        30485000
                                                               <<06212>>30490000
loop  :                                                        <<06212>>30495000
                                                                        30500000
while drq'entry'index <> 0 and                                 <<06660>>30505000
      double(drq'buf'dstn) <> obj                              <<07320>>30510000
do drq'entry'index := drq'nextq;                               <<07320>>30515000
                                                               <<06212>>30520000
if drq'entry'index <> 0 then                                   <<06392>>30525000
   begin                                                                30530000
   reqp:=drq'entry'index;                                      <<06392>>30535000
   next:=drq'nextq;                                            <<06392>>30540000
                                                               <<06212>>30545000
   <<take request off of deferred req q>>                      <<06212>>30550000
                                                               <<06212>>30555000
   dequeuediscreq(reqp, deferredreqq, noinfo);                 <<06212>>30560000
   ldr'disable := 0;   << turn off req disabled bit >>         <<06411>>30565000
   if ldr'ldreq then                                           <<06627>>30570000
      begin <<logical request>>                                <<06212>>30575000
                                                               <<06212>>30580000
      <<attach the request to the cdt entry's pending queue>>  <<06212>>30585000
                                                               <<06212>>30590000
      queuediscreq(reqp,cdtreqq,ldr'cdt);                      <<07320>>30595000
                                                               <<06212>>30600000
      sllheadinx := lpcb(ldr'pcb*pcbsize+sllixwordnum);        <<*8400>>30605000
      if sll(schedtoiomsg).slliocomptoawakecnt = 0 and         <<*8400>>30610000
         not sll(schedtoiomsg).sllswapipflag and               <<*8400>>30615000
         lpcb(ldr'pcb*pcbsize+wakemaskwordnum).                <<*8400>>30620000
                                       memorywaitflag then     <<*8400>>30625000
         awake(ldr'pcb*pcbsize,memorywaitcode,nowait);         <<*8400>>30630000
      <<inform disp to try a cache move>>                      <<06212>>30635000
                                                               <<06212>>30640000
      tos := ldr'cdt;                                          <<07320>>30645000
      tos := iostatusok;                                       <<06941>>30650000
      tos := cachemovereadycode;                               <<06212>>30655000
      sendmsg(schedpin,cachemoveport,3,0);                     <<06212>>30660000
                                                               <<06212>>30665000
      end                                                      <<06212>>30670000
                                                               <<06212>>30675000
   else queuediscreq(reqp,ditreqq,                             <<06675>>30680000
                     lpdt(ldr'ldev & lsl(2)+lpdt'ditp));       <<06675>>30685000
                                                               <<06212>>30690000
   drq'entry'index := next;                                    <<06392>>30695000
                                                               <<06212>>30700000
   go loop;                                                             30705000
   end;                                                                 30710000
                                                               <<06212>>30715000
end; <<checkfordeferreddiscreq>>                               <<06212>>30720000
                                                                        30725000
$page "I/O INTERFACE PROCEDURES : START OBJECT WRITE"          <<06212>>30730000
                                                               <<06212>>30735000
procedure startobjwrite(obj, urgclass, regionbase,             <<06660>>30740000
                        ldr'entry'index,discreqinx);           <<06212>>30745000
value obj,urgclass,regionbase, ldr'entry'index, discreqinx;    <<06660>>30750000
double  obj;                                                   <<06660>>30755000
integer urgclass, ldr'entry'index, discreqinx;                 <<06212>>30760000
double regionbase;                                             <<06212>>30765000
option privileged,uncallable;                                           30770000
                                                                        30775000
comment                                                                 30780000
                                                                        30785000
startobjwrite builds a disc write request for the specified cac<<06212>>30790000
domain or data segment, and queues the write request into the  <<06212>>30795000
appropriate disc queue via a call to queuediscreq to start the <<06212>>30800000
physical write. for writes of cached disc domains, the xfer    <<06212>>30805000
request element is provided in the calling sequence, whereas   <<06212>>30810000
the xfer request element for the physical write update of a    <<06212>>30815000
data segment is obtained in the routine. this is done since    <<06212>>30820000
the xfer req elt for a mapped domain is obtained in attachio an<<06212>>30825000
the same element is used for all disc reads and writes of theed<<06212>>30830000
mapped domain.  this prevents the strain on the critical pool  <<06212>>30835000
of memory management disc xfer requests for movement of        <<06212>>30840000
cached domains.                                                <<06212>>30845000
                                                               <<06212>>30850000
the request will be issued with the priority passed in the urg<<<06212>>30855000
parameter.  this will control the location in the disc queue, and       30860000
thereby the urgency of service for the request since disc queues        30865000
are serviced from the head.                                    <<06212>>30870000
                                                                        30875000
the data segment or cached disc domain is marked as having a wr<<06212>>30880000
in progress so that an overlay of the corresponding region will<<06212>>30885000
be held off until the write completes.                         <<06212>>30890000
                                                                        30895000
the logxferreq parameter points to the associated logical disc <<06212>>30900000
access request for cached disc domains.  the parameter is not  <<06212>>30905000
used for data segment writes.  it is needed for mapped domain  <<06212>>30910000
writes since the disc address and xfer counts are obtained     <<06212>>30915000
by looking into the associated logical xfer req elt.  the write<<06212>>30920000
of a mapped object is performed only for the portion of the    <<06212>>30925000
modified by the logical xfer request.                          <<06212>>30930000
                                                               <<06212>>30935000
                                                               <<06212>>30940000
***  this procedure assumes db is at sysdb on entry.           <<06212>>30945000
                                                               <<06212>>30950000
;                                                              <<06212>>30955000
                                                               <<06212>>30960000
begin                                                                   30965000
logical array objid(*)=obj;                                    <<06660>>30970000
equate serwq=4;  <<temp-delete with mpev>>                     <<06945>>30975000
double  xferbase;                                              <<06212>>30980000
                                                               <<06212>>30985000
integer                                                        <<06212>>30990000
        drq'entry'index,                                       <<06392>>30995000
        mstatparm4,                                            <<06948>>31000000
        dstentrynumber,                                        <<06212>>31005000
                                                               <<06411>>31010000
        ldev,                                                  <<06212>>31015000
        regionsize,                                            <<06212>>31020000
        mmbase=xferbase+1,                                     <<06212>>31025000
        mmbank=xferbase,                                       <<06212>>31030000
        xfercount,                                             <<06212>>31035000
        xferoffset,                                            <<06212>>31040000
        reghoda,                                               <<06212>>31045000
        regloda,                                               <<06212>>31050000
        xferhoda,                                              <<06212>>31055000
        xferloda;                                              <<06212>>31060000
                                                               <<06212>>31065000
double xferda=xferhoda,                                        <<06212>>31070000
       regionda=reghoda;                                       <<06212>>31075000
                                                               <<06212>>31080000
<<get the info needed for the transfer>>                       <<06212>>31085000
                                                               <<06212>>31090000
tos:=regionbase;                                               <<06212>>31095000
tos:=tos+rbtohodadisp;                                         <<06212>>31100000
asmb(ldea);                                                    <<06212>>31105000
regloda:=tos;  <<region's disc address>>                       <<06212>>31110000
reghoda:=s0.reghodafield;                                      <<06212>>31115000
ldev:=tos.regldevfield;     <<ldev>>                           <<06212>>31120000
tos:=tos+hodatorsdisp;                                         <<06212>>31125000
asmb(lsea);                                                    <<06212>>31130000
regionsize := tos*mmpagesize;                                  <<06212>>31135000
asmb(ddel);                                                    <<06212>>31140000
                                                               <<06212>>31145000
if not objid(objidtypefield)=objiddatatype                     <<06660>>31150000
and not objid(objidtypefield)=objidcdtype                      <<06660>>31155000
then suddendeath(sfkernbadparm);                               <<06212>>31160000
if objid(objidtypefield)=objiddatatype then                    <<06660>>31165000
   begin <<a data seg>>                                        <<06212>>31170000
   dstentrynumber := objid(objidnumfield);                     <<06660>>31175000
   xferda:=regionda; <<xfer entire object>>                    <<06212>>31180000
   x:=dstentrynumber&lsl(2)+dstsysbaseinx;                     <<06212>>31185000
   xfercount:=segdescfirminfo.datasizefield&lsl(2);            <<06212>>31190000
   xferoffset:=0;                                              <<06212>>31195000
   end;                                                        <<06660>>31200000
if objid(objidtypefield)=objidcdtype then                      <<06660>>31205000
   begin <<a mapped domain>>                                   <<06212>>31210000
   xferhoda:=ldr'parm1;   <<xfer disc address>>                <<d7738>>31215000
   xferloda:=ldr(x:=x+1);  << (ldr'parm2) >>                   <<d7738>>31220000
   if integer(ldr'ldev) <> ldev                                <<06212>>31225000
   then suddendeath(sfkerncacheintbad);                        <<06212>>31230000
                                                               <<06212>>31235000
   <<figure out xfer offset and xfer count>>                   <<06212>>31240000
                                                               <<06212>>31245000
   tos:=xferda-regionda;                                       <<06212>>31250000
   xferoffset := tos*sectorsizeinwords;                        <<06212>>31255000
   if < then suddendeath(sfkerncacheintbad);                   <<06212>>31260000
   xfercount:=ldr'count;                                       <<06212>>31265000
   if < then xfercount:=((-xfercount)+1) & asr(1);             <<06411>>31270000
   end;                                                        <<06212>>31275000
                                                               <<06212>>31280000
tos := regionbase;                                             <<06212>>31285000
tos:=tos+xferoffset;                                           <<06212>>31290000
xferbase:=tos;                                                 <<06212>>31295000
if logical(xferoffset+xfercount) > logical(regionsize)         <<06212>>31300000
and objid(objidtypefield)=objidcdtype                          <<06660>>31305000
                      <<seg expansions go over, but ok>>       <<06660>>31310000
then suddendeath(sfkerncacheintbad);                           <<06212>>31315000
                                                               <<06212>>31320000
                                                               <<06212>>31325000
<<get a disc transfer request element and fill it in>>                  31330000
                                                                        31335000
if discreqinx = 0                                              <<06392>>31340000
then discreqinx := getdiscreq(2);  <<no impede>>               <<06392>>31345000
drq'entry'index := discreqinx;                                 <<06392>>31350000
if = then suddendeath(601); <<disc req tab config too small>>  <<06392>>31355000
<<fill in the disc request element>>                                    31360000
drq'parm2:=xferloda;                                           <<06392>>31365000
drq'parm1:=xferhoda;                                           <<06392>>31370000
drq'ldev:=ldev;                                                <<06392>>31375000
drq'bufadr:=mmbase; <<xferbase>>                               <<06392>>31380000
drq'bufdst:=mmbank; <<xferbank>>                               <<06392>>31385000
drq'count:=xfercount; <<xfercount>>                            <<06392>>31390000
drq'segdisp := xferoffset;                                     <<06392>>31395000
tos:=0;                                                        <<06392>>31400000
drq'flags:=tos;                                                <<06392>>31405000
drq'stat := 0;                                                 <<06941>>31410000
drq'pcb := 0;        <<necessary for siodm function>>          <<08803>>31415000
drq'qmisc := 0;                                                <<07320>>31420000
drq'mmreq:=1;                                                  <<06392>>31425000
drq'func:=writereq;                                            <<06392>>31430000
drq'segid1 := objid(objiddescfield);                           <<06941>>31435000
drq'segid2 := objid(objidnumfield);                            <<06941>>31440000
drq'urgclas:=urgclass;                                         <<06392>>31445000
                                                                        31450000
<<set background write semaphore for data segs>>               <<06212>>31455000
                                                               <<06212>>31460000
if objid(objidtypefield)=objiddatatype                         <<06660>>31465000
then dst(dstentrynumber&lsl(2)+1).disccopyvalidflag:=0;        <<06212>>31470000
                                                                        31475000
<<set imoflag for the disc update of a cached disc domain>>    <<06212>>31480000
                                                               <<06212>>31485000
if objid(objidtypefield)=objidcdtype then                      <<06660>>31490000
   begin                                                       <<06212>>31495000
   cdt'abs'on'tos;                                             <<d7738>>31500000
   tos := tos + (objid(objidnumfield) * cdt'entry'size) +      <<d7738>>31505000
          cdt'md'flags;                                        <<d7738>>31510000
   asmb(lsea);   << load domain flags on tos >>                <<d7738>>31515000
   tos.(cdt'imo'bit:1) := 1;                                   <<d7738>>31520000
   asmb(ssea;ddel);  << store back flags word >>               <<d7738>>31525000
   if <> << imo bit was set beforehand >>                      <<d7738>>31530000
   then suddendeath(sfkerncachesyncbad);                       <<06212>>31535000
   end;                                                        <<06212>>31540000
                                                               <<06212>>31545000
<<record the write req pointer in the region header>>          <<06212>>31550000
                                                               <<06212>>31555000
tos:=regionbase;                                               <<06212>>31560000
tos:=tos+rbtowreqpdisp;                                        <<06212>>31565000
tos:=discreqinx;                                               <<06212>>31570000
asmb(ssea);                                                    <<06212>>31575000
                                                               <<06212>>31580000
                                                               <<06212>>31585000
<<log the write initiation event>>                             <<06212>>31590000
                                                                        31595000
mstatparm4 := ldev;                                            <<06948>>31600000
mstatparm4.(0:1) := 1;   << write >>                           <<06948>>31605000
mmstat'(mmstatsegioinit,objid(objiddescfield),                 <<06948>>31610000
       objid(objidnumfield),discreqinx,mstatparm4,0,0);        <<06948>>31615000
                                                               <<06212>>31620000
<<queue the write request>>                                    <<06212>>31625000
                                                               <<06212>>31630000
queuediscreq(discreqinx,if (objid(objidtypefield)=objidcdtype  <<06945>>31635000
             land ldr'serial'post) then serwq else ditreqq,    <<06945>>31640000
             lpdt(ldev&lsl(2) +lpdt'ditp));                    <<06945>>31645000
                                                               <<06212>>31650000
end  <<procedure startobjwrite>>;                              <<06212>>31655000
                                                                        31660000
$page "I/O INTERFACE PROCEDURES : PROCESS INITIATION MESSAGE"           31665000
procedure processinitmsg(regionbase);                                   31670000
value regionbase;                                                       31675000
double regionbase;                                                      31680000
option privileged,uncallable;                                           31685000
                                                                        31690000
comment                                                                 31695000
                                                                        31700000
this procedure examines the initiation message in the region            31705000
header to see if the action for which the region was reserved           31710000
may be initiated.  if the region is free of on-going i/o, and           31715000
the action is not externally disabled (due to the disc copy             31720000
not yet being current) then the appropriate action (request             31725000
a move or queue a read) is taken.                                       31730000
                                                                        31735000
;                                                                       31740000
                                                                        31745000
begin                                                                   31750000
                                                                        31755000
integer resregsize,                                                     31760000
        drq'entry'index,                                       <<06392>>31765000
        reqp,                                                           31770000
        origregsize,                                                    31775000
        newregsize;                                                     31780000
double relregbase;                                             <<06660>>31785000
double obj;                                                    <<06660>>31790000
logical array objident(*)=obj;                                 <<06660>>31795000
logical initmsg,                                               <<06212>>31800000
        timeforcompmsg:=false;                                 <<06212>>31805000
                                                               <<06212>>31810000
                                                                        31815000
tos := regionbase;                                             <<01571>>31820000
tos := tos + rbtoobjidentdisp;                                 <<06212>>31825000
asmb(ldea);            <<grab objident from region header>>    <<06660>>31830000
obj := tos;                                                    <<06660>>31835000
tos:=regionbase;                                                        31840000
tos:=tos+rbtoinitmsgdisp;                                               31845000
disable;                                                                31850000
asmb(lsea);                                                             31855000
initmsg:=tos;                                                           31860000
if initmsg.initmsgtoggleswitch then suddendeath(613);          <<01644>>31865000
if not initmsg.msgextdisabledflag then                                  31870000
   begin                                                                31875000
   if not initmsg.msgongoingiodisabledflag then                         31880000
      begin                                                             31885000
      if initmsg.msgvalidyetflag then                                   31890000
         begin   <<message is ready to go>>                             31895000
         initmsg.initmsgtoggleswitch:=1;                                31900000
         tos:=initmsg;                                                  31905000
         tos.initmsgrelrespagesflag:=0; <<clear semaphore>>             31910000
         asmb(ssea);                                                    31915000
         if initmsg.queuereadreqflag then                               31920000
            begin <<start up the read>>                        <<06212>>31925000
            enable;                                                     31930000
            timeforcompmsg:=false;                             <<06212>>31935000
            tos:=tos+initmsgtoinitinfodisp;                             31940000
            asmb(lsea);                                                 31945000
            drq'entry'index:=reqp:=tos;                        <<06392>>31950000
            mmstat'(mmstatsegioinit,objident(objiddescfield),  <<06948>>31955000
                   objident(objidnumfield),reqp,drq'ldev,0,0); <<06948>>31960000
            queuediscreq                                       <<06660>>31965000
               (reqp,ditreqq,lpdt(drq'ldev&lsl(2)+lpdt'ditp)); <<06675>>31970000
            end                                                <<06212>>31975000
         else if initmsg.initmsgstartcompflag                  <<06212>>31980000
              then timeforcompmsg := true;                     <<06212>>31985000
                                                                        31990000
         <<                                                             31995000
         fix header, check if some pages should be released             32000000
         >>                                                             32005000
                                                                        32010000
         tos:=regionbase;                                               32015000
         tos:=tos+rbtorpagecntdisp;                                     32020000
         asmb(lsea);                                                    32025000
         resregsize:=tos;                                               32030000
         tos:=0;                                                        32035000
         asmb(ssea);                                                    32040000
         initmsg.initmsgrelrespagesflag:=0;                             32045000
         if <> then                                                     32050000
            begin                                                       32055000
            if resregsize=0 then suddendeath(612);             <<01644>>32060000
            end                                                         32065000
         else if resregsize<>0 then suddendeath(612);          <<01644>>32070000
                                                                        32075000
         <<fix up selected region's header and trailer>>                32080000
                                                                        32085000
         tos:=tos+rpagecnttorsdisp;                                     32090000
         asmb(lsea);                                                    32095000
         origregsize:=s0;                                               32100000
         tos:=tos-resregsize;                                           32105000
         newregsize:=s0;                                                32110000
         asmb(ssea);                                                    32115000
         tos:=tos+rstossdisp;                                           32120000
         tos:=newregsize;                                               32125000
         asmb(ssea);                                                    32130000
         tos:=tos+sstoptrasdisp+newregsize&lsl(pagepower);              32135000
         tos:=regreservedcode;                                          32140000
         asmb(ssea);                                                    32145000
         tos:=tos+trastotrsdisp;                                        32150000
         tos:=newregsize;                                               32155000
         asmb(ssea);                                                    32160000
         tos:=tos+trstotssdisp;                                         32165000
         tos:=newregsize;                                               32170000
         asmb(ssea);                                                    32175000
                                                                        32180000
         <<                                                             32185000
         release extra pages off end of region                          32190000
         >>                                                             32195000
                                                                        32200000
         if resregsize <> 0 then                                        32205000
            begin                                                       32210000
                                                                        32215000
            <<fix up release region header and trailer>>                32220000
                                                                        32225000
            tos:=regionbase;                                            32230000
            tos:=tos+newregsize&lsl(pagepower);                         32235000
            asmb(ddup);                                                 32240000
            relregbase:=tos;                                            32245000
            tos:=tos+rbtorasdisp;                                       32250000
            tos:=regreservedcode;                                       32255000
            asmb(ssea);                                                 32260000
            tos:=tos+rastossdisp;                                       32265000
            tos:=resregsize;                                            32270000
            asmb(ssea);                                                 32275000
            tos:=tos+sstorsdisp;                                        32280000
            tos:=resregsize;                                            32285000
            asmb(ssea);                                                 32290000
            tos:=tos+rstoobjidentdisp;                         <<06212>>32295000
            tos :=0d;                                          <<06660>>32300000
            asmb(sdea);                                        <<06660>>32305000
            tos:=tos+objidenttoptssdisp+resregsize             <<06212>>32310000
                        &lsl(pagepower);                       <<06212>>32315000
            tos:=resregsize;                                            32320000
            asmb(ssea);                                                 32325000
            tos:=tos+tsstotrasdisp;                                     32330000
            tos:=regreservedcode;                                       32335000
            asmb(ssea);                                                 32340000
            tos:=tos+trastotrsdisp;                                     32345000
            tos:=resregsize;                                            32350000
            asmb(ssea);                                                 32355000
            tos:=relregbase;                                            32360000
            sendmsg(schedpin,relregreqport,2,0);                        32365000
            end;                                                        32370000
                                                               <<06212>>32375000
         if timeforcompmsg then                                <<06212>>32380000
            begin<<no read needed-better be a virgin mapped d>><<06212>>32385000
            if objident(objidtypefield)<> objidcdtype          <<07320>>32390000
            or objident(objidnumfield)= 0                      <<06660>>32395000
            then suddendeath(sfkerncacheintbad);               <<06212>>32400000
            processcompmsg(regionbase,obj,0,iostatusok);       <<06660>>32405000
            end;                                               <<06212>>32410000
         end;                                                           32415000
      end;                                                              32420000
   end;                                                                 32425000
end  <<procedure processinitmsg>>;                                      32430000
$page "I/O INTERFACE PROCEDURES : OBJECT WRITE COMPLETOR"      <<06212>>32435000
                                                                        32440000
procedure objwritecompletor(reqp);                             <<06212>>32445000
value reqp;                                                             32450000
integer reqp;                                                           32455000
option privileged,uncallable;                                           32460000
                                                                        32465000
                                                                        32470000
comment                                                                 32475000
                                                                        32480000
this procedure is called from the disc monitor (siodm)                  32485000
when a object write on behalf of memory management             <<06212>>32490000
has completed. if the region containing the written                     32495000
object has been cleared, and the region's on-going             <<06212>>32500000
i/o count falls to zero as a result of this write                       32505000
completion, processinitmsg is called to start up                        32510000
the activity for which the region was cleared. if                       32515000
another region has been reserved for the object which          <<06212>>32520000
was written out, the read is enabled and processinitmsg                 32525000
is called to get it started.                                            32530000
                                                                        32535000
;                                                                       32540000
                                                                        32545000
                                                                        32550000
begin                                                                   32555000
                                                                        32560000
                                                                        32565000
define                                                         <<07320>>32570000
   drq'abort'flag = flags.(0:1)#;                              <<07320>>32575000
                                                               <<07320>>32580000
double regionbase,                                             <<06660>>32585000
        obj;                                                   <<06660>>32590000
                                                               <<d7738>>32595000
double mapd'abs'addr;  << abs addr of mapped domain entry >>   <<d7738>>32600000
                                                               <<d7738>>32605000
logical array objident(*)=obj;                                 <<06660>>32610000
integer                                                        <<06212>>32615000
        iopin,                                                 <<06411>>32620000
        currentpin,                                            <<06411>>32625000
        ldr'entry'index,                                       <<06411>>32630000
        drq'entry'index,                                       <<06392>>32635000
        oldcdtimoflag,                                         <<06212>>32640000
        oldcdtxferstatus,                                      <<06212>>32645000
        oldcdtfwipflag,                                        <<06212>>32650000
        cdtentrynumber,                                        <<06212>>32655000
        stinx,                                                 <<06212>>32660000
        xferstatus;                                            <<06212>>32665000
                                                               <<06212>>32670000
                                                               <<06212>>32675000
logical forcedwrite,                                           <<06212>>32680000
        dataseg',                                              <<06613>>32685000
        sendmsgflags,                                          <<06212>>32690000
        imi:= false,                                           <<06411>>32695000
        flags;                                                 <<06212>>32700000
double newregionbase;                                          <<06411>>32705000
                                                                        32710000
<< *** db assumed to be at sysdb *** >>                        <<06212>>32715000
                                                                        32720000
<<                                                                      32725000
initialize local variables from disc req info                           32730000
>>                                                                      32735000
                                                               <<06212>>32740000
drq'entry'index :=reqp;                                        <<06392>>32745000
tos:=drq'bufdst;   <<regionbase>>                              <<06392>>32750000
tos:=drq'bufadr;                                               <<06392>>32755000
tos:=drq'segdisp;                                              <<06392>>32760000
if = then asmb(del) else asmb(sub); <<region base>>            <<06212>>32765000
regionbase:=tos;                                               <<06212>>32770000
objident(objiddescfield) := drq'segid1;                        <<06941>>32775000
objident(objidnumfield) := drq'segid2;                         <<06941>>32780000
if objident(objidtypefield)<> objiddatatype                    <<06660>>32785000
and objident(objidtypefield) <> objidcdtype                    <<07320>>32790000
then suddendeath(sfkernbadparm);                               <<06212>>32795000
                                                               <<06212>>32800000
if objident(objidtypefield)=objidcdtype then                   <<06660>>32805000
   begin                                                       <<06212>>32810000
   dataseg' := false;                                          <<06613>>32815000
   cdtentrynumber := objident(objidnumfield);                  <<d7738>>32820000
   cdt'abs'on'tos;                                             <<d7738>>32825000
   tos := tos + (cdtentrynumber * cdt'entry'size);             <<d7738>>32830000
   mapd'abs'addr := tos;                                       <<d7738>>32835000
   << reload index register for reqp addressing >>             <<d7738>>32840000
   x := reqp;                                                  <<d7738>>32845000
   end                                                         <<06212>>32850000
else                                                           <<06212>>32855000
   begin                                                       <<06212>>32860000
   dataseg' := true;                                           <<06613>>32865000
   stinx:=objident(objidnumfield)&lsl(2);  <<stinx>>           <<06660>>32870000
   end;                                                        <<06212>>32875000
xferstatus := drq'stat;                                        <<06392>>32880000
flags:=drq'flags; <<local variable flags>>                     <<06392>>32885000
                                                               <<06212>>32890000
<<log write completion event>>                                 <<06212>>32895000
                                                               <<06212>>32900000
mmstat'(mmstatsegiodone,objident(objiddescfield),              <<06948>>32905000
       objident(objidnumfield),reqp,%100000,0,0);              <<06948>>32910000
                                                               <<06212>>32915000
<<handle the case of a dataseg transfer failure>>              <<06212>>32920000
                                                               <<06212>>32925000
if xferstatus <> iostatusok                                    <<06945>>32930000
then suddendeath (sfkerndatasegwritefail);                     <<06212>>32935000
                                                               <<06212>>32940000
<<                                                                      32945000
release the disc request element                                        32950000
>>                                                                      32955000
                                                               <<06212>>32960000
if dataseg' then                                               <<06613>>32965000
   begin  <<return disc req entry>>                            <<06212>>32970000
   tos:=reqp;  <<fake the ptr parm>>                           <<06212>>32975000
   returndiscreq(*);                                           <<06212>>32980000
   end;                                                        <<06212>>32985000
                                                               <<06411>>32990000
                                                               <<06212>>32995000
<<                                                                      33000000
destroy reference to write request index in region header               33005000
>>                                                                      33010000
                                                               <<06212>>33015000
tos:=regionbase;                                                        33020000
tos:=tos+rbtowreqpdisp;                                                 33025000
asmb(lsea);                                                             33030000
if tos <> reqp and not drq'abort'flag                          <<07320>>33035000
then suddendeath(613);                                         <<01644>>33040000
tos:=0;                                                                 33045000
if not drq'abort'flag then                                     <<07320>>33050000
asmb(ssea;ddel);  <<if aborted, field reused so don't zap>>    <<06212>>33055000
if not drq'abort'flag then                                     <<07320>>33060000
   begin  <<write wasn't called off>>                                   33065000
                                                               <<06212>>33070000
   <<indicate in descriptor that write has completed>>         <<06212>>33075000
                                                               <<06212>>33080000
   if not dataseg' then                                        <<06613>>33085000
      begin <<clear in motion out bit in cdt entry>>           <<06212>>33090000
      tos := mapd'abs'addr;                                    <<d7738>>33095000
      tos := tos + cdt'md'flags;                               <<d7738>>33100000
      asmb(lsea);                                              <<d7738>>33105000
      tos.(cdt'imo'bit:1) := 0;                                <<d7738>>33110000
      if = then suddendeath(sfkerncachesyncbad);               <<d7738>>33115000
      asmb(ssea;ddel);  << store back flags word >>            <<d7738>>33120000
      end                                                      <<06212>>33125000
   else                                                        <<06212>>33130000
      begin  <<set disc copy valid flag in dst entry>>         <<06212>>33135000
      dst(stinx+1).disccopyvalidflag:=1;                       <<06212>>33140000
      if <> then suddendeath(613);                             <<06212>>33145000
      end;                                                     <<06212>>33150000
                                                               <<06212>>33155000
   <<                                                                   33160000
   initiate action pending on this write completion                     33165000
   >>                                                                   33170000
                                                               <<06212>>33175000
   <<check for imi object>>                                    <<06411>>33180000
                                                               <<06411>>33185000
   if not dataseg' then                                        <<06613>>33190000
      begin <<mapped domain>>                                  <<06411>>33195000
      tos := mapd'abs'addr;                                    <<d7738>>33200000
      exchdb;                                                  <<d7738>>33205000
      if cdt'array(cdt'md'flags).(cdt'imi'bit:1) = 1 then      <<d7738>>33210000
         begin <<it's on its way in somewhere>>                <<06411>>33215000
         newregionbase:=cdt'darray(cdt'md'mem'addr & asr(1));  <<d7738>>33220000
                                                               <<d7738>>33225000
         imi:=true;                                            <<06411>>33230000
         end;                                                  <<06411>>33235000
      exchdb;  << back to original db >>                       <<d7738>>33240000
      asmb(ddel);  << get rid of abs address >>                <<d7738>>33245000
      end;                                                     <<d7738>>33250000
   if dataseg' then                                            <<06613>>33255000
      begin <<check for read of dataseg into other region>>    <<06212>>33260000
                                                               <<06212>>33265000
   <<check for a pending read of the data segment into another><<06212>>33270000
   <<memory region.  this happens when the data segment was on><<06212>>33275000
   <<its way out but not recoverable since the memory region  ><<06212>>33280000
   <<it was sitting in was reserved for something else, but   ><<06212>>33285000
   <<the segment was needed again so a different region was   ><<06212>>33290000
   <<reserved for it and the read to that region is waiting   ><<06212>>33295000
   <<this write to complete. (a long sentence,huh?).          ><<06212>>33300000
                                                               <<06212>>33305000
   x:=stinx+dstsysbaseinx;<<for direct access to descriptor>>           33310000
   tos:=segdescflags;                                                   33315000
                                                               <<06212>>33320000
   <<see if seg is in motion in, i.e., a read into a different          33325000
     region for the seg is pending, waiting for the disk copy to        33330000
     become valid.  if so, try to get the read started.>>               33335000
   asmb(tbc imibit); <<in motion in flag>>                              33340000
   segdescflags:=tos;                                                   33345000
   if <> then                                                           33350000
      begin<<a different region has been reserved for the seg>>         33355000
      tos:=segdescbank;                                                 33360000
      tos:=segdescaddr;                                                 33365000
      newregionbase:=tos;                                      <<06411>>33370000
      imi:=true;                                               <<06411>>33375000
      end;                                                     <<06411>>33380000
   end;                                                        <<06411>>33385000
   if imi then                                                 <<06411>>33390000
      begin                                                    <<06411>>33395000
      tos := newregionbase;                                    <<06411>>33400000
      if xferstatus <> iostatusok then                         <<06212>>33405000
         begin <<write to disc failed>>                        <<06212>>33410000
                                                               <<06212>>33415000
         <<release new region and abort waiting procs>>        <<06212>>33420000
                                                               <<06212>>33425000
         undeferobjsmpq(regionbase,obj,xferstatus);            <<06660>>33430000
         sendmsg(schedpin,relregreqport,2,0);                           33435000
         suddendeath(sfkernnotsupported);<<should recover soft><<06212>>33440000
         enable;                                                        33445000
         end                                                            33450000
      else                                                              33455000
         begin  <<enable read>>                                         33460000
         disable;                                              <<07320>>33465000
         tos:=tos+rbtoinitmsgdisp;                                      33470000
         asmb(lsea);                                                    33475000
         tos.msgextdisabledflag:=0;                                     33480000
         asmb(ssea);                                                    33485000
         tos:=tos+initmsgtorbdisp;                                      33490000
         processinitmsg(*);                                             33495000
         end;                                                           33500000
      end;                                                              33505000
                                                               <<06411>>33510000
   <<now check if the region in which this dataseg or mapped >><<06212>>33515000
   <<disc domain is sitting has been reserved for something  >><<06212>>33520000
                                                                        33525000
   if dataseg' then                                            <<06613>>33530000
      begin  <<clear forced write flag in dst entry>>          <<06212>>33535000
      dst(stinx+1).fwipflag := 0;                              <<06212>>33540000
      if <> then forcedwrite := true else forcedwrite := false;<<06212>>33545000
      end                                                      <<06212>>33550000
   else                                                        <<06212>>33555000
      begin                                                    <<06212>>33560000
      tos := mapd'abs'addr;                                    <<d7738>>33565000
      tos := tos + cdt'md'flags;                               <<d7738>>33570000
      asmb(lsea);  << load domain's flags word >>              <<d7738>>33575000
      tos.(cdt'fwip'bit:1) := 0;                               <<d7738>>33580000
      asmb(ssea;ddel);  << store back flags word >>            <<d7738>>33585000
      if <> << fwip was 1 >>                                   <<d7738>>33590000
      then forcedwrite := true                                 <<06212>>33595000
      else forcedwrite := false;                               <<06212>>33600000
      end;                                                     <<06212>>33605000
                                                               <<06212>>33610000
   tos:=regionbase;                                                     33615000
                                                               <<06212>>33620000
   if not forcedwrite then tos:=tos+rbtosddisp else            <<06212>>33625000
      begin <<not an oc, so zero objident in reg head>>        <<06212>>33630000
      tos:=tos+rbtorasdisp;                                             33635000
      asmb(lsea);                                                       33640000
      tos.regreservedflag:=0; <<set if first subregion>>       <<06212>>33645000
      asmb(del);                                                        33650000
      if <> then tos:=tos+rastosddisp else                              33655000
         begin <<there aren't two objid cells in reg head>>    <<06212>>33660000
               <<so that if reserved, the new objid is there>> <<06212>>33665000
         tos:=tos+rastoobjidentdisp;                           <<06212>>33670000
         tos:=0d;                                              <<06660>>33675000
         asmb(sdea);  <<zap the indication that it was here>>  <<06660>>33680000
         tos:=tos+objidenttosddisp;                            <<06212>>33685000
         end;                                                           33690000
      end;                                                              33695000
                                                               <<06212>>33700000
   <<see if part of a cleaned region>>                                  33705000
                                                               <<06212>>33710000
   disable;                                                             33715000
   asmb(lsea);                                                          33720000
   tos.sdvalidflag:=0;                                                  33725000
   if <> then                                                           33730000
      begin  <<subregion may have been cleaned. flip to start>><<06212>>33735000
             <<of region and decrement it's ongoing i/o count>><<06212>>33740000
             <<if a reserved region>>                          <<06212>>33745000
                                                               <<06212>>33750000
      tos:=tos&lsl(pagepower);                                          33755000
      asmb(sub);                                                        33760000
      tos:=tos+sdtorasdisp;                                    <<06212>>33765000
      asmb(lsea);                                              <<06212>>33770000
      tos.regreservedflag:=0;                                  <<06212>>33775000
      if <> then                                               <<06212>>33780000
         begin  <<region is reserved>>                         <<06212>>33785000
         asmb(del);                                            <<06212>>33790000
         tos:=tos+rastoiocntdisp;                              <<06212>>33795000
         asmb(lsea);                                           <<06212>>33800000
         if <= then suddendeath(613); <<didn't wait>>          <<06212>>33805000
         tos:=tos-1;                                           <<06212>>33810000
         asmb(ssea);                                           <<06212>>33815000
         if = then                                             <<06212>>33820000
            begin  <<region is free of ongoing internal i/o>>  <<06212>>33825000
                                                               <<06212>>33830000
            <<start processing for the read into this region>> <<06212>>33835000
                                                               <<06212>>33840000
            tos:=tos+iocnttoinitmsgdisp;                       <<06212>>33845000
            asmb(lsea);                                        <<06212>>33850000
            tos.msgongoingiodisabled:=0;                       <<06212>>33855000
            asmb(ssea);                                        <<06212>>33860000
            tos:=tos+initmsgtorbdisp;                          <<06212>>33865000
            processinitmsg(*);                                 <<06212>>33870000
            end;                                               <<06212>>33875000
         end;                                                  <<06212>>33880000
      end;                                                     <<06212>>33885000
   end;                                                        <<06212>>33890000
                                                               <<06212>>33895000
<<invoke cache write completor for mapped disc domains>>       <<06212>>33900000
                                                               <<06212>>33905000
if not dataseg' then                                           <<06613>>33910000
   begin <<send disp write comp msg>>                          <<06212>>33915000
   tos:=cdtentrynumber;                                        <<06411>>33920000
   tos:=xferstatus;                                            <<06212>>33925000
   tos:=cachewritedonecode;                                    <<06212>>33930000
   sendmsgflags:=0;                                            <<06212>>33935000
   if curprc <> 0 then                                         <<06650>>33940000
      begin <<determine whether to prempt or not>>             <<06411>>33945000
      currentpin := (curprc)/pcbsize;                          <<06650>>33950000
      tos := mapd'abs'addr;                                    <<d7738>>33955000
      tos := tos + cdt'md'ldr'head;                            <<d7738>>33960000
      asmb(lsea;delb,delb);  << load ldr head on mapped entry ><<d7738>>33965000
      if (ldr'entry'index:=tos) <> 0 then begin                <<d7738>>33970000
         iopin:=ldr'pcb;                                       <<06411>>33975000
         if processpri(iopin) >= processpri(currentpin)        <<06411>>33980000
         then sendmsgflags.msgdon'tpreemptflag:=1;             <<06411>>33985000
         end;                                                  <<06411>>33990000
      end;                                                     <<06411>>33995000
   sendmsg(schedpin,cachemoveport,3,sendmsgflags);             <<06212>>34000000
   end;                                                        <<06212>>34005000
                                                               <<06212>>34010000
end  <<procedure objwritecompletor>>;                          <<06212>>34015000
                                                                        34020000
$page "I/O INTERFACE PROCEDURES : PROCESS COMPLETION MESSAGE"  <<06212>>34025000
comment                                                                 34030000
                                                                        34035000
processcompmsg is called to perform the actions which occur    <<06212>>34040000
when a segment or mapped disc domain becomes present.          <<06212>>34045000
                                                               <<06212>>34050000
the region in which the segment or mapped domain resides is    <<06212>>34055000
marked assigned. the segment or mapped domain is flagged presen<<06212>>34060000
for a seg, processes and devices queued on the segment's makepr<<06212>>34065000
are undeferred. datasegs are marked dirty, and pndg disc reques<<06212>>34070000
against them are reinitiated.  breakpoints are set for code seg<<06212>>34075000
                                                               <<06212>>34080000
for mapped domains, a message is sent to the dispatcher informi<<06212>>34085000
him of the arrival of the mapped domain and requesting that cac<<06212>>34090000
moves against it be performed.                                 <<06212>>34095000
                                                               <<06212>>34100000
;                                                                       34105000
                                                                        34110000
procedure processcompmsg(regionbase,obj,descstinx,iostat);     <<06660>>34115000
value regionbase,obj,descstinx,iostat;                         <<06660>>34120000
double regionbase;                                                      34125000
double  obj;                                                   <<06660>>34130000
integer descstinx,iostat;                                      <<06212>>34135000
option privileged,uncallable;                                  <<01696>>34140000
                                                                        34145000
begin                                                                   34150000
logical array objident(*)=obj;                                 <<06660>>34155000
integer next,                                                           34160000
        iopin,                                                 <<06411>>34165000
        sllheadinx,                                            <<*8400>>34170000
        pcbpt,                                                 <<06650>>34175000
        currentpin,                                            <<06411>>34180000
        ldr'entry'index,                                       <<06411>>34185000
        sendmsgflags,                                          <<06411>>34190000
        regionsize,                                                     34195000
        bptinx;                                                         34200000
                                                               <<d7738>>34205000
double mapd'abs'addr;  << abs addr of mapped domain entry >>   <<d7738>>34210000
                                                               <<d7738>>34215000
logical dataseg' := false,                                     <<06613>>34220000
        mappeddomain := false,                                 <<06212>>34225000
        codeseg := false;                                      <<06212>>34230000
                                                               <<06212>>34235000
                                                                        34240000
                                                                        34245000
subroutine markregionassigned;                                          34250000
                                                                        34255000
begin                                                                   34260000
tos:=regionbase;                                                        34265000
tos:=tos+rbtorasdisp;                                                   34270000
asmb(lsea);                                                             34275000
tos.regreservedflag:=0;                                                 34280000
if = then suddendeath(614);                                    <<01644>>34285000
tos.regassignedflag:=1;                                                 34290000
x:=s0;                                                                  34295000
asmb(ssea);                                                             34300000
tos:=tos+rastorsdisp;                                                   34305000
asmb(lsea);                                                             34310000
regionsize:=s0;                                                         34315000
tos:=tos&lsl(pagepower)+rstoptrasdisp;<<disp to tras>>                  34320000
asmb(add,ldxa;ssea); <<mark assigened in reg trailer>>                  34325000
tos:=tos+trastotrsdisp;                                                 34330000
asmb(lsea);                                                             34335000
if tos<>regionsize then suddendeath(614);                      <<01644>>34340000
tos:=tos+trstotssdisp;                                                  34345000
tos:=regionsize;                                                        34350000
asmb(ssea;ddel);                                                        34355000
end  <<subroutine markregionassigned>>;                                 34360000
                                                               <<06212>>34365000
subroutine markpresentclearimi;                                <<06212>>34370000
                                                               <<06212>>34375000
<< flags object as present and clears in motion in flag >>     <<06212>>34380000
                                                               <<06212>>34385000
begin                                                          <<06212>>34390000
                                                               <<06212>>34395000
if mappeddomain then                                           <<06212>>34400000
   begin  <<a mapped domain>>                                  <<06212>>34405000
   tos := mapd'abs'addr;                                       <<d7738>>34410000
   tos := tos + cdt'md'flags;                                  <<d7738>>34415000
   asmb(lsea);     << load mapped domain flags word >>         <<d7738>>34420000
   tos.(cdt'abs'bit:1) := 0;                                   <<d7738>>34425000
   if = then suddendeath(sfkerncachesyncbad);                  <<d7738>>34430000
   tos.(cdt'imi'bit:1) := 0;                                   <<d7738>>34435000
   if = then suddendeath(sfkerncachesyncbad);                  <<d7738>>34440000
   asmb(ssea;ddel);   << store back mapped domain flags >>     <<d7738>>34445000
   << turn on reference bit in region header >>                <<*7564>>34450000
   tos := regionbase;                                          <<*7564>>34455000
   tos := tos + rbtosasdisp;                                   <<*7564>>34460000
   asmb(lsea);                                                 <<*7564>>34465000
   tos.regrefflag := 1;                                        <<*7564>>34470000
   asmb(ssea;ddel);                                            <<*7564>>34475000
   end                                                         <<06212>>34480000
else                                                           <<06212>>34485000
   begin  <<a seg>>                                            <<06212>>34490000
   x:=descstinx+dstsysbaseinx;                                 <<06212>>34495000
   segdescfirminfo.absentflag:=0;                              <<06212>>34500000
   if = then suddendeath(613);                                 <<06212>>34505000
   segdescfirminfo.referencedflag:=1;  <<try not doing>>       <<06212>>34510000
   segdescflags.imiflag:=0;                                    <<06212>>34515000
   if =  then suddendeath(613);                                <<06212>>34520000
   end;                                                        <<06212>>34525000
                                                               <<06212>>34530000
end;  <<subroutine markobjectpresent>>                         <<06212>>34535000
                                                               <<06212>>34540000
<<initialize local variables>>                                 <<06212>>34545000
                                                               <<06212>>34550000
case objident(objidtypefield) of                               <<06660>>34555000
   begin                                                       <<06660>>34560000
   dataseg' := true;                                           <<06660>>34565000
   codeseg := true;                                            <<06660>>34570000
   codeseg := true;                                            <<06660>>34575000
   mappeddomain := true;                                       <<06660>>34580000
   end;                                                        <<06660>>34585000
                                                               <<06212>>34590000
<< if mapped domain, calculate entry's abs addr >>             <<d7738>>34595000
if mappeddomain then                                           <<d7738>>34600000
   begin                                                       <<d7738>>34605000
   cdt'abs'on'tos;                                             <<d7738>>34610000
   tos := tos + (objident(objidnumfield) * cdt'entry'size);    <<d7738>>34615000
   mapd'abs'addr := tos;                                       <<d7738>>34620000
   end;                                                        <<d7738>>34625000
                                                               <<d7738>>34630000
<<set completion message processed toggle switch>>             <<06212>>34635000
                                                               <<06212>>34640000
tos:=regionbase;                                                        34645000
tos:=tos+rbtocompmsgdisp;                                               34650000
asmb(lsea);                                                             34655000
tos.compmsgtoggleswitch:=1;                                             34660000
if <> then suddendeath(613);                                   <<01644>>34665000
asmb(ssea);                                                             34670000
                                                               <<06212>>34675000
<<record arrival time of this object >>                        <<06212>>34680000
                                                               <<06212>>34685000
tos:=tos+compmsgtoarrtimedisp;                                 <<06212>>34690000
tos:=timer;                                                    <<06212>>34695000
asmb(sdea);                                                    <<06212>>34700000
                                                               <<06212>>34705000
<<mark the region assigned>>                                   <<06212>>34710000
                                                               <<06212>>34715000
markregionassigned;                                                     34720000
                                                                        34725000
<<mark object present, clear in motion in indicator>>          <<06212>>34730000
                                                               <<06212>>34735000
markpresentclearimi;                                           <<06212>>34740000
                                                               <<06212>>34745000
                                                               <<06212>>34750000
                                                               <<06212>>34755000
<<special handling depending on object type>>                  <<06212>>34760000
                                                               <<06212>>34765000
                                                               <<06212>>34770000
if mappeddomain then                                           <<06212>>34775000
   begin  << mapped disc domain >>                             <<d7738>>34780000
   tos := mapd'abs'addr;                                       <<d7738>>34785000
   tos := tos + cdt'md'ldr'head;                               <<d7738>>34790000
   asmb(lsea;delb,delb);   << load ldr head to process >>      <<d7738>>34795000
   ldr'entry'index := tos;                                     <<d7738>>34800000
                                                               <<d7738>>34805000
   if <> <<ldr'entry'index <> 0>> then                         <<d7738>>34810000
   begin <<not a deferred disc request pending>>               <<06945>>34815000
   tos := ldr'entry'index;                                     <<*8400>>34820000
   while ldr'entry'index <> 0 do                               <<*8400>>34825000
      begin                                                    <<*8400>>34830000
      sllheadinx := lpcb(ldr'pcb*pcbsize+sllixwordnum);        <<*8400>>34835000
      if sll(schedtoiomsg).slliocomptoawakecnt = 0 and         <<*8400>>34840000
         not sll(schedtoiomsg).sllswapipflag and               <<*8400>>34845000
         lpcb(ldr'pcb*pcbsize+wakemaskwordnum).                <<*8400>>34850000
                                       memorywaitflag then     <<*8400>>34855000
         awake(ldr'pcb*pcbsize,memorywaitcode,nowait);         <<*8400>>34860000
      ldr'entry'index := ldr'nextq;                            <<*8400>>34865000
      end;                                                     <<*8400>>34870000
   ldr'entry'index := tos;                                     <<*8400>>34875000
   <<inform disp of pending cache moves>>                      <<06212>>34880000
   tos := objident(objidnumfield);                             <<06660>>34885000
   tos := iostat;                                              <<06212>>34890000
   tos := cachemovereadycode;                                  <<06212>>34895000
   sendmsgflags:=0;                                            <<06411>>34900000
   if curprc <> 0 then                                         <<06650>>34905000
      begin <<determine whether to prempt or not>>             <<06411>>34910000
      currentpin := (curprc)/pcbsize;                          <<06650>>34915000
      iopin:=ldr'pcb;                                          <<06411>>34920000
      if processpri(iopin) >= processpri(currentpin)           <<06411>>34925000
      then sendmsgflags.msgdon'tpreemptflag:=1;                <<06411>>34930000
      end;                                                     <<06411>>34935000
   sendmsg(schedpin,cachemoveport,3,sendmsgflags);             <<06411>>34940000
   end;                                                        <<06945>>34945000
   end;                                                        <<06212>>34950000
                                                               <<06212>>34955000
if dataseg' then                                               <<06613>>34960000
   begin <<data segment>>                                               34965000
   dst(x:=descstinx+1).disccopyvalidflag:=0; <<mark dirty>>    <<06212>>34970000
   if =  then suddendeath(613);                                <<06212>>34975000
   if dqh'disahead <> 0                                        <<06392>>34980000
   then checkfordeferreddiscreq(obj);                          <<06660>>34985000
   end;                                                                 34990000
                                                               <<06212>>34995000
                                                                        35000000
if codeseg then                                                <<06212>>35005000
   begin <<check for pending breakpoints>>                     <<06212>>35010000
   tos := curprc;                                              <<06650>>35015000
   if = then asmb(del) else                                             35020000
      begin                                                             35025000
      pcbpt := curprc;                                         <<06650>>35030000
      tos := bptlink;                                          <<06650>>35035000
      if = then asmb(del) else                                          35040000
         begin <<see if current process has a bkpt in objident><<06212>>35045000
         bptinx:=tos;                                          <<mm.iv>>35050000
         setsegsbkpts(obj,descstinx,bptinx);                   <<06660>>35055000
         end;                                                           35060000
      end;                                                              35065000
   if sys'bkpt then setsegsbkpts(obj,descstinx,                <<06660>>35070000
                                 sys'bkpt'ext'x);              <<mm.iv>>35075000
   end;                                                                 35080000
                                                                        35085000
<< undefer waiting processes and devices >>                    <<06212>>35090000
                                                               <<06212>>35095000
undeferobjsmpq(regionbase,obj,iostat);                         <<06660>>35100000
                                                               <<06212>>35105000
end  <<processcompmsg>>;                                                35110000
                                                                        35115000
$page "I/O INTERFACE PROCEDURES : OBJ READ COMPLETOR"          <<06212>>35120000
                                                                        35125000
procedure objreadcompletor(reqp);                              <<06212>>35130000
value reqp;                                                             35135000
logical reqp;                                                           35140000
option privileged,uncallable;                                           35145000
                                                                        35150000
comment                                                                 35155000
                                                                        35160000
this procedure is called from the disc monitor when                     35165000
the read of an object on behalf of memory management           <<06212>>35170000
has been completed.  if the object is a data segment,          <<06212>>35175000
it is checked if an internal move is required, and if so,      <<06212>>35180000
a message is sent to the dispatcher to perform the move.       <<06212>>35185000
otherwise, the completion message processor is invoked         <<06212>>35190000
to perform the activities pending on the arrival of this       <<06212>>35195000
object.                                                        <<06212>>35200000
                                                                        35205000
;                                                                       35210000
                                                                        35215000
                                                                        35220000
begin                                                                   35225000
double  regionbase;                                            <<06212>>35230000
                                                               <<06212>>35235000
integer regionbank=regionbase,                                 <<06212>>35240000
        regionaddr=regionbase+1;                               <<06212>>35245000
                                                               <<06212>>35250000
double  obj;                                                   <<06660>>35255000
logical array objident(*)=obj;                                 <<06660>>35260000
integer stinx,                                                 <<06212>>35265000
        drq'entry'index,                                       <<06392>>35270000
        xferstatus,                                            <<06212>>35275000
        xfercount,                                             <<06212>>35280000
        cdtentrynum;                                           <<06212>>35285000
                                                               <<06212>>35290000
logical dataseg' := false,                                     <<06613>>35295000
                                                               <<06212>>35300000
        readabortflag: = false,                                <<06212>>35305000
        mappeddomain := false;                                 <<06212>>35310000
                                                               <<06212>>35315000
<<get info from i/o request element                                     35320000
  and initialize local variables>>                                      35325000
                                                                        35330000
drq'entry'index:=reqp;                                         <<06392>>35335000
tos:=drq'bufdst;                                               <<06392>>35340000
tos:=drq'bufadr;                                               <<06392>>35345000
tos:=drq'segdisp;                                              <<06392>>35350000
if = then asmb(del) else asmb(sub); <<region base>>                     35355000
regionbase:=tos;                                               <<06212>>35360000
objident(objiddescfield) := drq'segid1;                        <<06941>>35365000
objident(objidnumfield) := drq'segid2;                         <<06941>>35370000
if objident(objidtypefield)=objidcdtype then                   <<06660>>35375000
      begin <<mapped domain arriving>>                         <<06212>>35380000
      mappeddomain := true;                                    <<06212>>35385000
      cdtentrynum:=objident(objidnumfield);                    <<06660>>35390000
      end;                                                     <<06660>>35395000
                                                               <<06212>>35400000
if objident(objidtypefield)=objiddatatype then                 <<06660>>35405000
      begin  <<data segment arriving>>                         <<06212>>35410000
      dataseg' := true;                                        <<06613>>35415000
      stinx:=objident(objidnumfield)&lsl(2)                    <<06660>>35420000
      end;                                                     <<06212>>35425000
if objident(objidtypefield)=objidsltype or                     <<06660>>35430000
   objident(objidtypefield)=objidpgmtype then                  <<06660>>35435000
     stinx:=convsegidtostinx(obj); <<code seg>>                <<06660>>35440000
drq'entry'index:=reqp;                                         <<06392>>35445000
xferstatus := drq'stat;                                        <<06392>>35450000
xfercount := drq'count;                                        <<06392>>35455000
if logical(drq'abort)                                          <<06392>>35460000
then readabortflag := true;                                    <<06212>>35465000
                                                               <<06212>>35470000
if readabortflag then suddendeath(sfkernnotsupported);         <<06212>>35475000
                                                               <<06212>>35480000
                                                                        35485000
<<log segment read completion event>>                          <<06212>>35490000
                                                               <<06212>>35495000
mmstat'(mmstatsegiodone,drq'segid1,drq'segid2,reqp,0,0,0);     <<06948>>35500000
                                                               <<06212>>35505000
<<kill the system if disc read of segment failed>>             <<06212>>35510000
                                                               <<06212>>35515000
if xferstatus <> iostatusok                                    <<06212>>35520000
and not mappeddomain                                           <<06212>>35525000
then suddendeath(sfkernsegreadfail);                           <<06212>>35530000
                                                               <<06212>>35535000
<<stuff fetch iostatus into region header>>                    <<06212>>35540000
                                                               <<06212>>35545000
tos:=regionbase;                                               <<06212>>35550000
tos:=tos+rbtosasdisp;                                          <<06212>>35555000
asmb(lsea);                                                    <<06212>>35560000
tos.regfetchiostatus := xferstatus;                            <<06212>>35565000
asmb(ssea;ddel);                                               <<06212>>35570000
                                                               <<06212>>35575000
<<return disk request entry to system>>                        <<06212>>35580000
                                                               <<06212>>35585000
if not mappeddomain then                                       <<06212>>35590000
   begin  <<return disc req entry>>                            <<06212>>35595000
   tos:=reqp;  <<fake the ptr parm>>                           <<06212>>35600000
   returndiscreq(*);                                           <<06212>>35605000
   end;                                                        <<06212>>35610000
                                                               <<06212>>35615000
<<get things going that are waiting for this read to complete>><<06212>>35620000
                                                               <<06212>>35625000
if mappeddomain                                                <<06212>>35630000
then processcompmsg(regionbase,obj,0,xferstatus)               <<06660>>35635000
else                                                           <<06212>>35640000
   begin  <<seg read completion>>                              <<06212>>35645000
                                                               <<06212>>35650000
   <<check for a pending internal move for stack exp/cont>>    <<06212>>35655000
   tos:=regionbase;                                                     35660000
   tos:=tos+rbtocompmsgdisp;                                            35665000
   asmb(lsea);                                                          35670000
   tos.compmsgmodflag:=0;                                               35675000
   if = then processcompmsg(regionbase,obj,stinx,xferstatus)   <<06660>>35680000
   else                                                        <<06212>>35685000
      begin  <<mod to seg required before flagged present>>             35690000
      tos:=obj;                                                <<06660>>35695000
      sendmsg(schedpin,segmodreadyport,2,0);                   <<06660>>35700000
      end;                                                              35705000
   end;                                                                 35710000
end   <<objreadcompletor>>;                                    <<06212>>35715000
$page "Memory Allocation Procedures: TakeOffARL"               <<06945>>35720000
procedure takeoffarl(address,size);                            <<06945>>35725000
value address,size;                                            <<06945>>35730000
double address;                                                <<06945>>35735000
integer size;                                                  <<06945>>35740000
option privileged,uncallable;                                  <<06945>>35745000
                                                               <<06945>>35750000
comment                                                        <<06945>>35755000
                                                               <<06945>>35760000
takeoffarl is called by recoveroc, makeoc, reserveregion,      <<06945>>35765000
and releaseregion to remove the region whose base is given     <<06945>>35770000
by the address parameter from the list of available regions.   <<06945>>35775000
                                                               <<06945>>35780000
db is assumed to be at sysdb.                                  <<06945>>35785000
                                                               <<06945>>35790000
the condition code is not affected by this procedure.          <<06945>>35795000
                                                               <<06945>>35800000
;                                                              <<06945>>35805000
                                                               <<06945>>35810000
   begin                                                       <<06945>>35815000
   double nextlink,                                            <<06945>>35820000
          prevlink;                                            <<06945>>35825000
                                                               <<06945>>35830000
   if size > maxavailreg then suddendeath(0);                  <<06945>>35835000
                                                               <<06945>>35840000
   holecount := holecount-1;                                   <<06945>>35845000
   if < then suddendeath(619);                                 <<06945>>35850000
                                                               <<06945>>35855000
<< look up addresses of prev hole and next link from header >> <<06945>>35860000
                                                               <<06945>>35865000
   tos := address;                                             <<06945>>35870000
   tos := tos+rbtopldisp;                                      <<06945>>35875000
   asmb(ldea);                                                 <<06945>>35880000
   prevlink := tos;                                            <<06945>>35885000
   tos := tos+pltonldisp;                                      <<06945>>35890000
   asmb(ldea);                                                 <<06945>>35895000
   nextlink := tos;                                            <<06945>>35900000
   asmb(ddel);                                                 <<06945>>35905000
                                                               <<06945>>35910000
<< take the region off the free hole list >>                   <<06945>>35915000
                                                               <<06945>>35920000
   if prevlink <> 0d then                                      <<06945>>35925000
      begin   << region is not the first in the list. >>       <<06945>>35930000
                                                               <<06945>>35935000
<< place next link into previous hole's next link >>           <<06945>>35940000
                                                               <<06945>>35945000
      tos := prevlink;                                         <<06945>>35950000
      tos := tos+pltonldisp;                                   <<06945>>35955000
      tos := nextlink;                                         <<06945>>35960000
      asmb(sdea;ddel);                                         <<06945>>35965000
                                                               <<06945>>35970000
<< place previnlist into next hole's previous pointer >>       <<06945>>35975000
                                                               <<06945>>35980000
      if nextlink=0d then                                      <<06945>>35985000
         begin   << that was the last hole in the list. >>     <<06945>>35990000
                                                               <<06945>>35995000
<< update hole list tail and max avail region size >>          <<06945>>36000000
                                                               <<06945>>36005000
         tos := prevlink;                                      <<06945>>36010000
         tos := tos + pltonldisp;                              <<06945>>36015000
         holelisttail := tos;                                  <<06945>>36020000
         tos := prevlink;                                      <<06945>>36025000
         tos := tos+pltorsdisp;                                <<06945>>36030000
         asmb(lsea);                                           <<06945>>36035000
         maxavailreg := tos;                                   <<06945>>36040000
         end                                                   <<06945>>36045000
      else                                                     <<06945>>36050000
         begin    << not the last hole in the list >>          <<06945>>36055000
         tos := nextlink;                                      <<06945>>36060000
         tos := tos+nltopldisp;                                <<06945>>36065000
         tos := prevlink;                                      <<06945>>36070000
         asmb(sdea;ddel);   << new prev link for next in list ><<06945>>36075000
         end;                                                  <<06945>>36080000
      end                                                      <<06945>>36085000
   else                                                        <<06945>>36090000
      begin        << removing first in list >>                <<06945>>36095000
      if nextlink = 0d then                                    <<06945>>36100000
         begin     << system is out of holes. >>               <<06945>>36105000
         maxavailreg := 0;                                     <<06945>>36110000
         holelisttail := holelisthead := 0d;                   <<06945>>36115000
         end                                                   <<06945>>36120000
      else                                                     <<06945>>36125000
         begin    << there's a hole after this one >>          <<06945>>36130000
                                                               <<06945>>36135000
<< make next hole the new head. >>                             <<06945>>36140000
                                                               <<06945>>36145000
         holelisthead := nextlink;                             <<06945>>36150000
         tos := nextlink;                                      <<06945>>36155000
         tos := tos+nltopldisp;                                <<06945>>36160000
         tos := 0d;                                            <<06945>>36165000
         asmb(sdea;ddel);   << erase previous link >>          <<06945>>36170000
         end;                                                  <<06945>>36175000
      end;                                                     <<06945>>36180000
   end;    << procedure takeoffarl >>                          <<06945>>36185000
$page "Memory allocation procedures: put on avail reg list"    <<06945>>36190000
$include inclparl                                              <<06945>>36195000
                                                               <<06945>>36200000
                                                               <<06945>>36205000
                                                               <<06945>>36210000
$page "MEMORY ALLOCATION PROCEDURES : RELEASE REGION "                  36215000
procedure releaseregion(regionbase,reqsize);                            36220000
value regionbase,reqsize;                                               36225000
double regionbase;                                                      36230000
integer reqsize;                                                        36235000
option privileged,uncallable;                                           36240000
                                                                        36245000
comment                                                                 36250000
                                                                        36255000
this procedure combines the region beginning at                         36260000
regionbase with neighboring available regions and links                 36265000
the resultant into the appropriate available region list.               36270000
                                                                        36275000
;                                                                       36280000
                                                                        36285000
                                                                        36290000
begin                                                                   36295000
                                                                        36300000
<<db assumed at sysdb on entry>>                                        36305000
                                                                        36310000
integer rsizeinpages,                                                   36315000
        sreg,                                                  <<06945>>36320000
        zreg,                                                  <<06945>>36325000
        turnedoffsize:=0;                                               36330000
double traileraddr,                                                     36335000
       nextaddr;                                                        36340000
logical garbcollok := true;                                    <<06945>>36345000
                                                                        36350000
                                                                        36355000
subroutine turnoffsdvalidflags;                                         36360000
                                                                        36365000
comment                                                                 36370000
                                                                        36375000
turnoffsdvalidflags is called to turn off the subregion                 36380000
displacement valid flags for the subregions which are part              36385000
of a reserved region which is being returned to the available           36390000
region pool.  the reserve on the region had been aborted, and           36395000
the subregion displacements and initiation message are no longer        36400000
valid.                                                                  36405000
                                                                        36410000
;                                                                       36415000
                                                                        36420000
begin                                                                   36425000
tos:=regionbase;                                                        36430000
tos:=tos+rbtorsdisp;                                                    36435000
asmb(lsea);                                                             36440000
rsizeinpages:=tos;                                                      36445000
tos:=tos+rstosddisp;                                                    36450000
disable;                                                                36455000
while turnedoffsize < rsizeinpages do                                   36460000
   begin                                                                36465000
   tos:=0;                                                              36470000
   asmb(ssea);                                                          36475000
   tos:=tos+sdtossdisp;                                                 36480000
   asmb(lsea);                                                          36485000
   turnedoffsize:=turnedoffsize+s0;                                     36490000
   tos:=tos&lsl(pagepower);                                             36495000
   tos:=tos+sstosddisp;                                                 36500000
   asmb(ladd);                                                          36505000
   if carry and turnedoffsize<>rsizeinpages                    <<01644>>36510000
   then suddendeath(614); <<off bank>>                         <<01644>>36515000
   end;                                                                 36520000
asmb(ddel);                                                             36525000
end <<turnoffsdvalidflags>>;                                            36530000
                                                                        36535000
<< log the release region event>>                              <<06212>>36540000
                                                               <<06212>>36545000
                                                               <<06212>>36550000
                                                               <<06212>>36555000
                                                                        36560000
tos := 13;    <<***>>                                          <<06948>>36565000
tos := reqsize; <<***>>                                        <<06948>>36570000
tos := regionbase;  <<***>>                                    <<06948>>36575000
mmstat'(*,*,*,*,0,0,0);                                        <<06948>>36580000
                                                               <<06212>>36585000
<< invalidate control cells in the region >>                   <<06212>>36590000
                                                               <<06212>>36595000
tos:=regionbase;                                                        36600000
tos:=tos+rbtoinitmsgdisp;                                               36605000
tos:=0;                                                                 36610000
asmb(ssea); <<zero out init msg for clean region>>                      36615000
tos:=tos+initmsgtorasdisp;                                              36620000
tos:=regavailablecode; <<mark region available>>               <<06212>>36625000
asmb(ssea);                                                             36630000
tos:=tos+rastorsdisp;                                                   36635000
asmb(lsea);                                                             36640000
rsizeinpages:=tos;                                                      36645000
asmb(ddel);                                                             36650000
                                                               <<06212>>36655000
turnoffsdvalidflags;                                                    36660000
                                                                        36665000
if bugcatch then                                                        36670000
   begin  <<check integrity>>                                           36675000
   tos:=regionbase;                                                     36680000
   tos:=tos+rbtossdisp;                                                 36685000
   asmb(lsea);                                                          36690000
   x:=s0;                                                               36695000
   tos:=tos&lsl(pagepower)+sstorasdisp+rastoptssdisp;                   36700000
   asmb(ladd;lsea);                                                     36705000
   if tos<>x then suddendeath(614);                            <<01644>>36710000
   tos:=x;                                                              36715000
   asmb(ssea;ddel);                                                     36720000
                                                                        36725000
   tos:=regionbase;                                                     36730000
   asmb(xch,del);                                                       36735000
   if s0.(10:6) <> headerlength then suddendeath(614);         <<01644>>36740000
   tos:=tos&lsr(pagepower);                                             36745000
   x:=tos;                                                              36750000
   if rsizeinpages=maxholesize and x<>0                        <<01644>>36755000
   then suddendeath(614);                                      <<01644>>36760000
   if rsizeinpages+x>maxholesize then suddendeath(614);        <<01644>>36765000
   end;                                                                 36770000
                                                                        36775000
<<                                                                      36780000
try to combine with available region above                              36785000
>>                                                                      36790000
                                                                        36795000
tos:=regionbase;                                                        36800000
tos:=tos+rbtorsdisp;                                                    36805000
asmb(lsea);                                                             36810000
tos:=tos&lsl(pagepower);<<region size in words>>                        36815000
if = then                                                               36820000
   begin <<a whole bank or invalid>>                                    36825000
   if rsizeinpages <> maxholesize then suddendeath(614);       <<01644>>36830000
   s0:=-1;<<force a carry below>>                                       36835000
   end;                                                                 36840000
asmb(ladd);                                                             36845000
if carry then asmb(ddel) <<end of bank>> else                           36850000
   begin                                                                36855000
   <<check if past partial last bank>>                                  36860000
   asmb(ddup,ddup);                                                     36865000
   nextaddr:=tos;                                              <<06212>>36870000
   if lastmemoryaddress<=nextaddr then asmb(ddel) <<end mem>> else      36875000
      begin <<there's a region above>>                                  36880000
      tos:=tos+rstoptrasdisp;                                           36885000
      tos:=regavailablecode;                                            36890000
      asmb(ssea);  <<mark reg available in trailer for recoveroc>>      36895000
      tos:=tos+trastotrsdisp;                                           36900000
      tos:=rsizeinpages;                                                36905000
      asmb(ssea);                                                       36910000
      tos:=tos+ptrstorasdisp;                                           36915000
      asmb(lsea);                                                       36920000
      tos.regavailableflag:=0;                                          36925000
      asmb(del);                                                        36930000
      if = then asmb(ddel) else                                         36935000
         begin  <<following region is available>>                       36940000
         tos:=tos+rastorsdisp;                                          36945000
         asmb(lsea); <<next region's size>>                             36950000
         rsizeinpages:=rsizeinpages+s0;                                 36955000
         s1:=s1+rstorbdisp;                                             36960000
         takeoffarl(*,*);                                               36965000
         end;                                                           36970000
      end;                                                              36975000
   end;                                                                 36980000
                                                                        36985000
<<                                                                      36990000
try to combine with previous region                                     36995000
>>                                                                      37000000
                                                                        37005000
tos:=regionbase;                                                        37010000
if ptrastorbdisp > ls0 then asmb(ddel) else                             37015000
   begin  <<region being released is not the first in the bank>>        37020000
   if bugcatch then                                                     37025000
      begin  <<check integrity>>                                        37030000
      tos:=regionbase;                                                  37035000
      tos:=tos+rbtoptrsdisp;                                            37040000
      asmb(lsea);                                                       37045000
      x:=tos;                                                           37050000
      tos:=tos+ptrstorsdisp;                                            37055000
      tos:=x&lsl(pagepower);                                            37060000
      asmb(lsub;lsea);                                                  37065000
      tos:=x;                                                           37070000
      asmb(cmp);                                                        37075000
      if <> and s1<>0 then suddendeath(614);                   <<01644>>37080000
      asmb(ddel);                                                       37085000
      end;                                                              37090000
   tos:=tos+rbtoptrasdisp;                                              37095000
   asmb(lsea);                                                          37100000
   tos.regavailableflag:=0;                                             37105000
   asmb(del);                                                           37110000
   if = then asmb(ddel) else                                            37115000
      begin  <<previous region is available>>                           37120000
      tos:=tos+trastotrsdisp;                                           37125000
      asmb(lsea);                                                       37130000
      rsizeinpages:=rsizeinpages+s0;                                    37135000
      x:=s0;                                                            37140000
      tos:=tos&lsl(pagepower);                                          37145000
      s1:=s1+ptrstorbdisp;                                              37150000
      asmb(lsub,ddup); <<yields region base of prev available region>>  37155000
      regionbase:=tos;  <<new beginning of avail reg>> <<***>>          37160000
      takeoffarl(*,x);                                                  37165000
      end;                                                              37170000
   end;                                                                 37175000
                                                                        37180000
<<                                                                      37185000
fix up combined region's header and trailer                             37190000
>>                                                                      37195000
                                                                        37200000
tos:=regionbase;                                                        37205000
tos:=tos+rbtorsdisp;                                                    37210000
tos:=rsizeinpages;                                                      37215000
asmb(ssea);  <<fix up new region header>>                               37220000
tos:=tos+rstorasdisp;                                                   37225000
tos:=regavailablecode;                                                  37230000
asmb(ssea);                                                             37235000
tos:=tos+rastoptrasdisp;                                                37240000
tos:=rsizeinpages&lsl(pagepower);                                       37245000
if <> then asmb(add) else                                               37250000
   begin <<a whole bank is free>>                                       37255000
   if rsizeinpages<>maxholesize then suddendeath(614);         <<01644>>37260000
   asmb(ddel);                                                          37265000
   tos:=lasttrasaddr;                                                   37270000
   end;                                                                 37275000
asmb(ddup);                                                             37280000
traileraddr:=tos;                                                       37285000
<<address of new region's trailer state cell on tos>>                   37290000
tos:=regavailablecode;                                                  37295000
asmb(ssea);                                                             37300000
tos:=tos+trastotrsdisp;                                                 37305000
tos:=rsizeinpages;                                                      37310000
asmb(ssea);                                                             37315000
putonarl(regionbase,rsizeinpages,putatend);                             37320000
if reqsize > maxavailreg then                                  <<06945>>37325000
   begin <<consider collecting garbage around this hole>>      <<06945>>37330000
   if curprc <> 0 then                                         <<06945>>37335000
      begin <<see if enough space for garb coll>>              <<06945>>37340000
      push (s);                                                <<06945>>37345000
      sreg := tos;                                             <<06945>>37350000
      push (z);                                                <<06945>>37355000
      zreg := tos;                                             <<06945>>37360000
      if zreg-sreg < 380 then garbcollok := false;             <<06945>>37365000
      end;                                                     <<06945>>37370000
   if garbcollok then collectgarbage(regionbase);              <<06945>>37375000
   end;                                                        <<06945>>37380000
if scanpoint > regionbase and scanpoint < traileraddr                   37385000
then scanpoint:=regionbase;                                             37390000
end  <<releaseregion>>;                                                 37395000
$page "MEMORY ALLOCATION PROCEDURES : CLEANREGION"                      37400000
                                                                        37405000
procedure cleanregion(regionbase,cleanpagecnt,urgclass,                 37410000
   specialcleaninfo);                                                   37415000
value regionbase,cleanpagecnt,urgclass,specialcleaninfo;                37420000
double regionbase;                                                      37425000
integer cleanpagecnt,urgclass,specialcleaninfo;                         37430000
option privileged,uncallable;                                           37435000
                                                                        37440000
comment                                                                 37445000
                                                                        37450000
cleanregion is invoked by reserveregion and collectgarbage              37455000
to prepare a reserved region for a segment read or an avail-            37460000
able region for a possible segment move.                                37465000
                                                                        37470000
cleanregion is called by reserveregion after a succeeful                37475000
allocation of an available region of adequate size for a                37480000
request made by the scheduler and called by collectgarbage              37485000
to clean a region so that memory compaction may take                    37490000
place over it.                                                          37495000
                                                                        37500000
cleanregion makes all overlay candidates in a reserved                  37505000
region non-recoverable, causes disc requests for segment                37510000
writes in the region which have not yet completed to be                 37515000
placed into the device's preemptive subqueue(if clean not               37520000
for garbage collection), and releases any leftover pages                37525000
which exceed the requested cleanpagecnt.                                37530000
                                                                        37535000
;                                                                       37540000
                                                                        37545000
begin                                                                   37550000
                                                               <<06212>>37555000
<<db is placed at the first word of the region>>                        37560000
<<identifiers for accessing global region header words>>       <<06212>>37565000
<<with db direct references                           >>       <<06212>>37570000
                                                               <<06212>>37575000
integer iocnt=db+rastoiocntdisp,                                        37580000
        regionstate=db+0,                                               37585000
        regionsize=db+rastorsdisp,                                      37590000
        releasepagecnt=db+rastorpagecntdisp,                            37595000
        makepresentlink=db+rastompqlinkdisp,                            37600000
        lkfzcounters=db+rastolkfzcntdisp,                               37605000
        wdiofzcounters=db+rastowdiofzcntdisp,                           37610000
        regobjident=db+rastoobjidentdisp,                      <<06212>>37615000
                                                               <<06212>>37620000
        compmsg=db+rastocompmsgdisp,                                    37625000
        ioreqq=db+rastoioreqqdisp,                                      37630000
        initmsg=db+rastoinitmsgdisp;                                    37635000
                                                                        37640000
<<identifiers for accessing subregion header fields>>          <<06212>>37645000
<<with db direct indexed references                >>          <<06212>>37650000
                                                               <<06212>>37655000
integer array subregobjident(*)=db+rastoobjidentdisp,          <<06660>>37660000
              subregassstate(*)=db+rastosasdisp,               <<06212>>37665000
              ssize(*)=db+rastossdisp,                                  37670000
              subreghoda(*)=db+rastohodadisp,                           37675000
              subregloda(*)=db+rastolodadisp,                           37680000
              subregwreqp(*)=db+rastowreqpdisp,                         37685000
              subregsd(*)=db+rastosddisp,                      <<06212>>37690000
              subregtime(*)=db+rastoarrtimedisp;               <<06212>>37695000
                                                                        37700000
<<defines to access subregion fields with db at base of reg and<<06212>>37705000
<<and x at the base of the header of the subregion>>           <<06212>>37710000
                                                               <<06212>>37715000
define ochoda=subreghoda(x)#,                                           37720000
       ocloda=subregloda(x)#,                                           37725000
       ocwreqp=subregwreqp(x)#,                                         37730000
       subregdisp=subregsd(x)#,                                         37735000
       subregsize=ssize(x)#,                                            37740000
       subregstate=subregassstate(x)#,                         <<06212>>37745000
       ocobjident=subregobjident(x)#,                          <<06212>>37750000
       arrivaltime=subregtime(x)#;                             <<06212>>37755000
                                                                        37760000
double savedb,                                                          37765000
        obj,                                                   <<06660>>37770000
       ocdiscaddress;                                                   37775000
logical array objidentifier(*) = obj;                          <<06660>>37780000
logical dataimflg,                                                      37785000
        cacheddiscdomain,                                      <<06212>>37790000
        overlaycand,                                           <<06212>>37795000
        fwip,                                                  <<06945>>37800000
        datasegflg;                                                     37805000
                                                                        37810000
integer stinx,                                                          37815000
        drq'entry'index,                                       <<06392>>37820000
        cdtentrynumber,                                        <<06212>>37825000
        ocwritereqptr,                                                  37830000
        newregsize,                                                     37835000
        subregworddisp,                                                 37840000
        residue,                                                        37845000
        oldregsize,                                                     37850000
        residualsize,                                                   37855000
        pagedispcnt:=0,                                                 37860000
        subregstate'0=subregassstate,                          <<06212>>37865000
        writecnt:=0;                                                    37870000
                                                                        37875000
                                                               <<02056>>37880000
                                                               <<06212>>37885000
tos:=regionbase;                                                        37890000
tos:=tos+rbtorasdisp;                                                   37895000
exchdb; <<db to beginning of region's global header>>                   37900000
savedb:=tos;                                                            37905000
oldregsize:=regionsize;                                                 37910000
iocnt:=releasepagecnt:=0;<<init counter cells in the region header>>    37915000
initmsg:=compmsg:=ioreqq:=0;                                            37920000
if specialcleaninfo=garbcollcode then initmsg.garbcollflag:=1;          37925000
                                                                        37930000
                                                               <<06212>>37935000
                                                                        37940000
do                                                                      37945000
   begin  <<clean next subregion>>                                      37950000
                                                               <<06212>>37955000
   <<zap control flags related to subregion>>                  <<06212>>37960000
   disable;  <<enable after each subregion>>                   <<06212>>37965000
                                                               <<06212>>37970000
   datasegflg:=dataimflg:=cacheddiscdomain :=                  <<06212>>37975000
      fwip:=                                                   <<06945>>37980000
      overlaycand:=false;                                      <<06212>>37985000
                                                               <<06212>>37990000
   <<get static info from subreg header while convenient>>     <<06212>>37995000
                                                               <<06212>>38000000
   x:=subregworddisp:=pagedispcnt&lsl(pagepower);<<for addressi<<06212>>38005000
                                                               <<06212>>38010000
                                                               <<06212>>38015000
                                                               <<06212>>38020000
                                                               <<06212>>38025000
   tos:=ochoda; <<for st descriptor>>                                   38030000
   tos:=ocloda; <<save loda for later insertion into st descr>>         38035000
   ocdiscaddress:=tos;                                                  38040000
                                                               <<06212>>38045000
   ocwritereqptr:=ocwreqp;                                     <<06212>>38050000
                                                               <<06212>>38055000
    << fill in the subregion's displacement from base>>                 38060000
                                                               <<06212>>38065000
   tos:=pagedispcnt;                                                    38070000
   tos.sdvalidflag:=1;                                                  38075000
   subregdisp:=tos; <<needed for segments in motion so that             38080000
                      ongoing i/ocount can be decremented               38085000
                      when motion completes.>>                          38090000
                                                               <<06212>>38095000
                                                               <<06212>>38100000
   tos:=subregsize;                                                     38105000
   if = then suddendeath(614);                                 <<01644>>38110000
   pagedispcnt:=pagedispcnt+tos; <<how far up are we?>>        <<06212>>38115000
   if pagedispcnt>oldregsize then suddendeath(614);            <<01644>>38120000
                                                               <<06212>>38125000
   <<let's see what's in here>>                                <<06212>>38130000
                                                               <<06212>>38135000
   tos:=subregobjident(x);                                     <<06660>>38140000
   tos:=subregobjident(x+1);                                   <<06660>>38145000
   asmb(decx);                                                 <<06660>>38150000
   obj:=tos;                                                   <<06660>>38155000
   if objidentifier(objidtypefield)= objidcdtype then          <<06660>>38160000
      begin  <<a cached disc domain is sitting here>>          <<06212>>38165000
      cacheddiscdomain := true;                                <<06212>>38170000
      cdtentrynumber := objidentifier(objidnumfield);          <<06660>>38175000
      end;                                                     <<06212>>38180000
                                                               <<06212>>38185000
   if obj <> 0d then                                           <<06660>>38190000
      begin <<there's something in the sub-region>>            <<06212>>38195000
                                                               <<06212>>38200000
      <<decode objident and mark object as unrecoverable>>     <<06212>>38205000
                                                               <<06212>>38210000
      if cacheddiscdomain then                                 <<06212>>38215000
         begin  <<a cached disc domain is sitting here>>       <<06212>>38220000
         x:=subregworddisp; <<for addressing>>                 <<06212>>38225000
                                                               <<06212>>38230000
         if cdtentrynumber <> 0 then                           <<06212>>38235000
            begin  <<cached disc domain is mapped in>>         <<06212>>38240000
                                                               <<06212>>38245000
            <<clear roc flag in region header,cdtentry>>       <<06212>>38250000
                                                               <<06212>>38255000
            subregstate.regrocflag:=0;<<domain's rocflag>>     <<06945>>38260000
            if = then                                          <<06945>>38265000
               begin <<not an overlay cand>>                   <<06945>>38270000
               if cdt'get'bit(cdtentrynumber,cdt'fwip'bit,0)   <<06945>>38275000
               <> 1 then suddendeath(sfkerncachesyncbad);      <<06945>>38280000
               fwip:=true; <<already going out>>               <<06945>>38285000
               end                                             <<06945>>38290000
            else                                               <<06945>>38295000
               begin                                           <<06945>>38300000
            if cdt'set'bit(objidentifier(objidnumfield),       <<06660>>38305000
                           cdt'roc'bit, 0) <> 1                <<06212>>38310000
            then suddendeath(sfkerncachesyncbad);              <<06212>>38315000
            overlaycand := true;                               <<06212>>38320000
            end;                                               <<06212>>38325000
               end;                                            <<06945>>38330000
                                                               <<06212>>38335000
         <<now unhook from cached disc domain list if need be>><<06212>>38340000
                                                               <<06212>>38345000
         tos:=regionbase;                                      <<06212>>38350000
         tos:=tos+subregworddisp;                              <<06212>>38355000
            if not fwip then                                   <<06945>>38360000
         unlinkcachedregion (*);                               <<06212>>38365000
                                                               <<06212>>38370000
         end                                                   <<06212>>38375000
      else                                                     <<06212>>38380000
         begin <<a segment is sitting here>>                   <<06212>>38385000
                                                               <<06212>>38390000
         if objidentifier(objidtypefield)=objiddatatype then   <<06660>>38395000
            begin  <<dat seg>>                                 <<06212>>38400000
            datasegflg:=true;                                  <<06212>>38405000
            stinx:=objidentifier(objidnumfield)&lsl(2);        <<06660>>38410000
                                                               <<06212>>38415000
                                                               <<06212>>38420000
            end                                                <<06212>>38425000
         else stinx:=convsegidtostinx(obj);                    <<06660>>38430000
                                                               <<06212>>38435000
         <<clear roc flag in seg descriptor>>                  <<06212>>38440000
                                                               <<06212>>38445000
         x:=stinx;                                             <<06212>>38450000
         dst(x:=x+1).rocflag:=0;                               <<06212>>38455000
         if <> then overlaycand := true else                   <<06212>>38460000
            begin  <<obj in subregion wasn't an overlay cand>> <<06212>>38465000
                   <<rather, subregion available due to an abor<<06212>>38470000
                   <<space reservation or forced write due to g<<06212>>38475000
                                                               <<06212>>38480000
            if not datasegflg then suddendeath(614);           <<06212>>38485000
            if dst(x).disccopyvalidflag =1                     <<06212>>38490000
            and ocwritereqptr =  0 then suddendeath(614);      <<06212>>38495000
            end;                                               <<06212>>38500000
         end;                                                  <<06212>>38505000
                                                               <<06212>>38510000
      <<if a write of the obj is pending, bump the write's>>   <<06212>>38515000
      <<priority and inc the region's on-going i/o count>>     <<06212>>38520000
                                                               <<06212>>38525000
      if datasegflg or cacheddiscdomainflag then               <<06212>>38530000
         begin <<find out if write is on-going>>               <<06212>>38535000
         if ocwritereqptr <> 0 then                            <<06212>>38540000
            begin                                              <<06212>>38545000
            dataimflg := true; <<can't split this subregion>>  <<06212>>38550000
            iocnt:=iocnt+1;                                    <<06212>>38555000
            initmsg.msgongoingiodisabled:=1;                   <<06212>>38560000
            tos :=%1000d;   << must go to sysdb for this call>><<06945>>38565000
            asmb(xchd);                                        <<06945>>38570000
            bumpwritepri(ocwritereqptr,                        <<06945>>38575000
                         forcedwritepri);                      <<06945>>38580000
            asmb(xchd;ddel); << put db back to region >>       <<06945>>38585000
            if datasegflg then                                 <<06212>>38590000
               begin                                           <<06212>>38595000
               if logical(dst(x:=stinx+1)).disccopyvalidflag   <<06212>>38600000
               then suddendeath(618);                          <<06212>>38605000
               dst(x).fwipflag:=1; <<signal write comp>>       <<06212>>38610000
               end                                             <<06212>>38615000
            else                                               <<06212>>38620000
               begin <<cached domain>>                         <<06212>>38625000
               cdt'set'bit(cdtentrynumber,cdt'fwip'bit,1);     <<06945>>38630000
               <<actually this can occur-first gc reserve, then<<06212>>38635000
               <<regular reserve with write on-going in both>> <<06212>>38640000
               end;                                            <<06212>>38645000
            end;                                               <<06212>>38650000
         end;                                                  <<06212>>38655000
                                                               <<06212>>38660000
      if overlaycand or cacheddiscdomainflag then              <<06411>>38665000
         begin  <<seg was an overlay candidate>>               <<06212>>38670000
                                                               <<06212>>38675000
         <<measure overlay of this type of object>>            <<06212>>38680000
                                                               <<06212>>38685000
         if gclassenabledmask.class0 then                               38690000
            begin  <<measure release of obj>>                  <<06212>>38695000
            tos:=measstatxdsbank;                                       38700000
            tos:=measstatxdsbase;                                       38705000
            tos:=tos+c0sub0'segreloff;                                  38710000
            if cacheddiscdomain then tos:=tos+c'cacherelease   <<06212>>38715000
            else if datasegflg then tos:=tos+c'datarelease     <<06212>>38720000
            else tos:=tos+c'coderelease;                       <<06212>>38725000
            asmb(lsea);                                                 38730000
            tos:=tos+1;                                                 38735000
            asmb(ssea;ddel);                                            38740000
            end;                                                        38745000
                                                               <<06212>>38750000
         <<measure overlay on behalf of this process>>         <<06212>>38755000
                                                               <<06212>>38760000
         if gclassenabledmask.class15 then                     <<06212>>38765000
            begin <<prcocess level ovly caused>>               <<06212>>38770000
            tos:=measprocxdsbank;                              <<06212>>38775000
            tos:=measprocxdsbase;                              <<06212>>38780000
            tos:=ics(-ics'candpincell);                        <<06212>>38785000
            tos:=tos*class15'sub0size+cp'overlaycaused;        <<06212>>38790000
            asmb(ladd);                                        <<06212>>38795000
            asmb(lsea);                                        <<06212>>38800000
            tos:=tos+1;                                        <<06212>>38805000
            asmb(ssea;ddel);                                   <<06212>>38810000
            end;                                               <<06212>>38815000
         if overlaycand and not cacheddiscdomain then          <<06212>>38820000
            begin <<put disc address into seg descriptor>>     <<06212>>38825000
            tos:=ocdiscaddress;                                <<06212>>38830000
            dst(x:=stinx+3):=tos;  <<put loda of oc into st des<<06212>>38835000
            dst(x:=x-1):=tos;  <<put hoda of oc into st desc>> <<06212>>38840000
            end;                                               <<06212>>38845000
         end;                                                  <<06212>>38850000
      end;                                                              38855000
                                                               <<06212>>38860000
   x:=subregworddisp; <<for addressing into subregion's header><<06212>>38865000
                                                               <<06212>>38870000
   <<if subregion free of on-going write, delete object's trace<<06212>>38875000
                                                               <<06212>>38880000
   if not dataimflg then                                                38885000
      begin                                                             38890000
      subregobjident(x):=0; subregobjident(x+1):=0;            <<06660>>38895000
      asmb(decx);                                              <<06660>>38900000
      ocwreqp:=0;                                                       38905000
      end;                                                              38910000
                                                               <<06212>>38915000
   <<how much more needs to be cleaned?>>                      <<06212>>38920000
                                                               <<06212>>38925000
   residue:=pagedispcnt-cleanpagecnt; <<for cc and below>>              38930000
   enable;                                                     <<06212>>38935000
                                                               <<06212>>38940000
   end                                                                  38945000
                                                               <<06212>>38950000
until >=; <<do until cleaned enough space>>                    <<06212>>38955000
                                                                        38960000
disable;                                                       <<06212>>38965000
                                                               <<06212>>38970000
if iocnt = 0 then                                              <<06212>>38975000
   begin  <<write may have completed in mean time>>            <<06212>>38980000
   dataimflg := false;  <<no longer>>                          <<06212>>38985000
   initmsg.msgongoingiodisable := 0; <<turn off>>              <<06212>>38990000
   end;                                                        <<06212>>38995000
                                                               <<06212>>39000000
<<now take care of extra space in the last subregion cleaned>> <<06212>>39005000
                                                               <<06212>>39010000
if dataimflg then                                                       39015000
   begin <<cannot split last subregion>>                                39020000
   newregsize:=pagedispcnt; <<make region bigger temporarily>> <<06212>>39025000
   releasepagecnt:=residue; <<i/o completor will release>>              39030000
   if <> then initmsg.initmsgrelrespagesflag:=1;                        39035000
   end                                                                  39040000
else                                                                    39045000
   begin <<last subregion can be split>>                                39050000
                                                               <<06212>>39055000
   newregsize:=cleanpagecnt; <<cleaned a region of right size>><<06212>>39060000
   releasepagecnt:=0; <<nothing for read completor to release>><<06212>>39065000
                                                               <<06212>>39070000
   <<if split the last subregion,fix up its headers/trailers>>          39075000
                                                               <<06212>>39080000
   if residue <> 0 then                                                 39085000
      begin  <<split last subregion>>                                   39090000
      x:=subregworddisp;                                                39095000
      tos:=subregsize:=subregsize-residue;<<size of left subregion>>    39100000
      x:=x+rastoptssdisp;                                               39105000
      x:=x+s0&lsl(pagepower);                                           39110000
      mem(x):=tos;<<left subregion's trailer>>                          39115000
      x:=cleanpagecnt&lsl(pagepower);                                   39120000
      subregsize:=residue;<<subregion size of right subregion>>         39125000
      subregobjident(x):=0;  <<two word object identifiers>>   <<06660>>39130000
      subregobjident(x+1):=0;<<so two zero stores>>            <<06660>>39135000
      asmb(decx);                                              <<06660>>39140000
      x:=x+residue&lsl(pagepower)+rastoptssdisp;                        39145000
      mem(x):=residue; <<sub size in right trailer>>                    39150000
      x:=x+tsstotrasdisp;                                               39155000
      mem(x):=regavailablecode;                                         39160000
      end;                                                              39165000
   end;                                                                 39170000
                                                                        39175000
initmsg.msgvalidyetflag:=1; <<signals write completor>>        <<06212>>39180000
                                                                        39185000
<<                                                                      39190000
put new region sizes in global headers and trailers                     39195000
>>                                                                      39200000
                                                                        39205000
x:=0;  <<for addressing convenience>>                                   39210000
regionsize:=newregsize; <<put new region size in header>>               39215000
regionstate.regclearedflag:=1; <<for garbage collection>>               39220000
x:=newregsize&lsl(pagepower)+rastoptrsdisp;                             39225000
mem(x):=newregsize; <<put new region size into trailer>>                39230000
mem(x:=x+trstotrasdisp):=regionstate; <<new region state into trailer>> 39235000
                                                                        39240000
<<                                                                      39245000
zero out cells of header not containing current info                    39250000
>>                                                                      39255000
                                                                        39260000
wdiofzcounters:=lkfzcounters:=makepresentlink:=0;              <<06212>>39265000
subregstate'0 := 0;                                            <<06212>>39270000
                                                               <<06212>>39275000
                                                                        39280000
<<                                                                      39285000
release extra pages above required portion of region                    39290000
>>                                                                      39295000
                                                                        39300000
residualsize:=oldregsize-newregsize;                                    39305000
if = then                                                               39310000
   begin  <<no extra space above region to release>>                    39315000
   tos:=savedb;                                                         39320000
   exchdb;                                                              39325000
   end                                                                  39330000
else                                                                    39335000
   begin  <<release xtra pages>>                                        39340000
   mem(x).regavailableflag:=0; <<prevent concatenation in relreg>>      39345000
   x:=x+ptrastorsdisp;                                                  39350000
   mem(x):=residualsize;                                                39355000
   x:=x+residualsize&lsl(pagepower)+rstoptrsdisp;                       39360000
   mem(x):=residualsize;                                                39365000
   tos:=savedb;                                                         39370000
   exchdb;                                                              39375000
   tos:=regionbase;                                                     39380000
   tos:=tos+newregsize&lsl(pagepower);                                  39385000
   releaseregion(*,0);                                                  39390000
   end;                                                                 39395000
end   <<cleanregion>>;                                                  39400000
$page "MEMORY ALLOCATION PROCEDURES : RESERVE REGION"                   39405000
double procedure reserveregion(reqsize,upperlimitsize,urgclass,         39410000
   specialinfo,passed'regionbase);                             <<06945>>39415000
value reqsize,upperlimitsize,urgclass,specialinfo,             <<06945>>39420000
      passed'regionbase;                                       <<06945>>39425000
integer reqsize,upperlimitsize,urgclass,specialinfo;                    39430000
double passed'regionbase;                                      <<06945>>39435000
option privileged,uncallable;                                           39440000
                                                                        39445000
                                                                        39450000
                                                                        39455000
comment                                                                 39460000
                                                                        39465000
reserveregion is called from fetchobject to procure an         <<06212>>39470000
available region for a pending segment fetch request, and from          39475000
collectgarbage to procure an available region for a move of             39480000
assigned regions which are sitting between two holes.                   39485000
                                                                        39490000
for lock requests, the regionbase to be reserved is passed in the       39495000
regionbase parameter.  for normal region reservation requests,          39500000
reserveregion checks the maxavail cell of the main memory state         39505000
table to see if if a region of adequate size is available.              39510000
if not, control is returned with reserveregion value of 0.              39515000
if an available region of adequate size is around, the available        39520000
region size bitmap (arsbm) is scanned from the request size up          39525000
to determine the size of the best fit available region. the region      39530000
at the head of that list is unlinked.                                   39535000
                                                                        39540000
after the region to be reserved is selected, cleanregion is called to   39545000
to force the writes pending in the region and to update the             39550000
ongoing i/o count in the region.  any residual pages are released,      39555000
and the double word address of the region's base is returned.           39560000
                                                                        39565000
;                                                                       39570000
                                                                        39575000
begin                                                                   39580000
integer wordinx,                                                        39585000
        bestfitsize;                                                    39590000
double                                                         <<06945>>39595000
   regionbase;                                                 <<06945>>39600000
                                                               <<06945>>39605000
subroutine findbestfithole;                                    <<06945>>39610000
                                                               <<06945>>39615000
   begin                                                       <<06945>>39620000
                                                               <<06945>>39625000
   if reqsize = maxavailreg then                               <<06945>>39630000
      begin      << give the tail of the list >>               <<06945>>39635000
      tos := holelisttail;                                     <<06945>>39640000
      tos := tos + nltorbdisp;                                 <<06945>>39645000
      regionbase := tos;                                       <<06945>>39650000
      bestfitsize := maxavailreg;                              <<06945>>39655000
      end                                                      <<06945>>39660000
   else                                                        <<06945>>39665000
      begin          << must chase through list >>             <<06945>>39670000
      tos := nltorsdisp;    << offset to size >>               <<06945>>39675000
      tos := reqsize;       << test word >>                    <<06945>>39680000
      tos := holelisthead;  << addr of first link >>           <<06945>>39685000
      x := holecount;       << link count >>                   <<06945>>39690000
      asmb(llsh);                                              <<06945>>39695000
      if <> then suddendeath(619);                             <<06945>>39700000
                                                               <<06945>>39705000
      tos := tos+nltorsdisp;                                   <<06945>>39710000
      asmb(lsea);                                              <<06945>>39715000
      bestfitsize := tos;                                      <<06945>>39720000
      tos := tos+rstorbdisp;                                   <<06945>>39725000
      regionbase := tos;                                       <<06945>>39730000
      asmb(ddel);                                              <<06945>>39735000
      end;                                                     <<06945>>39740000
   end;      << subroutine findbestfithole >>                  <<06945>>39745000
                                                               <<06945>>39750000
                                                               <<06945>>39755000
if reqsize>maxavailreg then suddendeath(619);                  <<01644>>39760000
if specialinfo = lockcode then                                          39765000
   begin  <<already know which region to use>>                          39770000
   tos := reserveregion := regionbase := passed'regionbase;    <<06945>>39775000
   tos:=tos+rbtorsdisp;                                                 39780000
   asmb(lsea);                                                          39785000
   bestfitsize:=tos;                                                    39790000
   asmb(ddel);                                                          39795000
   end                                                                  39800000
else                                                                    39805000
   begin <<must select region to be reserved>>                          39810000
   findbestfithole;                                            <<06945>>39815000
   if (upperlimitsize < bestfitsize) lor                       <<06945>>39820000
      (specialinfo = garbcollcode land                         <<06945>>39825000
       regionbase = passed'regionbase) then                    <<06945>>39830000
      reserveregion := regionbase := 0d                        <<06945>>39835000
   else                                                                 39840000
      begin <<selected size is ok>>                                     39845000
      reserveregion := regionbase;                             <<06945>>39850000
      if = then suddendeath(619);                              <<01644>>39855000
      end;                                                              39860000
   end;                                                                 39865000
                                                                        39870000
tos:=regionbase;                                                        39875000
if <> then                                                              39880000
   begin <<got a region>>                                      <<06212>>39885000
                                                               <<06212>>39890000
   <<take it off the available region list>>                   <<06212>>39895000
                                                               <<06212>>39900000
   tos := mmstatallocmem;  <<***>>                             <<06948>>39905000
   tos := reqsize;  <<***>>                                    <<06948>>39910000
   tos := regionbase; <<***>>                                  <<06948>>39915000
   mmstat'(*,*,*,*,0,0,0);                                     <<06948>>39920000
   takeoffarl(regionbase,bestfitsize);                                  39925000
                                                               <<06212>>39930000
                                                               <<06212>>39935000
   <<mark region reserved in header for cleaning>>             <<06212>>39940000
                                                               <<06212>>39945000
   tos:=tos+rbtorasdisp;                                       <<06212>>39950000
   tos:=regreservedcode;                                       <<06212>>39955000
   disable; <<reserved code used by write completor>>          <<06212>>39960000
   asmb(ssea);                                                 <<06212>>39965000
                                                               <<06212>>39970000
   <<now get the region cleaned out>>                          <<06212>>39975000
                                                               <<06212>>39980000
   cleanregion(regionbase,reqsize,urgclass,specialinfo);                39985000
                                                               <<06212>>39990000
   <<now mark reserved in trailer>>                            <<06212>>39995000
   tos:=tos+rastorsdisp;                                                40000000
   asmb(lsea); <<size of region allocated>>                             40005000
   tos:=tos&lsl(pagepower);                                             40010000
   if = then                                                            40015000
      begin <<whole bank allocated for the seg>>                        40020000
      asmb(ddel);                                                       40025000
      tos:=lasttrasaddr;                                                40030000
      end                                                               40035000
   else                                                                 40040000
      begin                                                             40045000
      asmb(ladd);                                                       40050000
      if nocarry then tos:=tos+rstoptrasdisp else                       40055000
         begin <<allocated region extends to end of bank>>              40060000
         asmb(del);                                                     40065000
         tos:=lasttrasaddr;                                             40070000
         end;                                                           40075000
      end;                                                              40080000
   tos:=regreservedcode;                                                40085000
   asmb(ssea);                                                          40090000
   end;                                                                 40095000
end   <<reserveregion>>;                                                40100000
$page "MEMORY ALLOCATION PROCEDURES : RECOVER OVERLAY CANDIDATE"        40105000
procedure recoveroc (obj,segdescstinx, ocregionbase);          <<06660>>40110000
value obj, segdescstinx, ocregionbase;                         <<06660>>40115000
double ocregionbase,obj;                                       <<06660>>40120000
integer segdescstinx;                                          <<06660>>40125000
option privileged,uncallable;                                           40130000
                                                                        40135000
comment                                                                 40140000
                                                                        40145000
recoveroc is called by fetchobject, absence trap handlers and  <<06212>>40150000
mapdiscdomain to recover a segment or cached disc domain which <<06212>>40155000
is sitting in an available subregion but not yet consumed by   <<06212>>40160000
reserveregion.                                                 <<06212>>40165000
                                                               <<06212>>40170000
the process of recovering the region consists of breaking the  <<06212>>40175000
ambient available region, and releasing the available subregion<<06212>>40180000
above and below the required subregion, if any exist.  the     <<06212>>40185000
required subregion is marked assigned, and if it is a segment o<<06212>>40190000
a mapped disc domain the related descriptor is flagged present.<<06212>>40195000
                                                               <<06212>>40200000
                                                                        40205000
;                                                                       40210000
                                                                        40215000
begin                                                                   40220000
                                                                        40225000
<<db assumed at sysdb on entry>>                                        40230000
                                                                        40235000
logical array objid(*)=obj;                                    <<06660>>40240000
integer sizebelow,                                                      40245000
        sizeabove,                                                      40250000
        next,                                                           40255000
        pcbpt,                                                 <<06650>>40260000
        segalloc,                                                       40265000
        cdtentrynumber,                                        <<06212>>40270000
        regionsize;                                                     40275000
                                                                        40280000
logical dataseg',                                              <<06613>>40285000
        codeseg,                                               <<06212>>40290000
        cacheddomain;                                          <<06212>>40295000
                                                                        40300000
                                                               <<06212>>40305000
double regionbase;                                             <<06212>>40310000
                                                                        40315000
integer bptinx;                                                         40320000
                                                                        40325000
                                                                        40330000
<<db assumed to be at sysdb>>                                           40335000
                                                               <<06212>>40340000
<<turn off traps since can execute on process' stack from inin><<06212>>40345000
                                                               <<06212>>40350000
turnofftraps;                                                  <<01644>>40355000
                                                               <<06212>>40360000
<<what type of object are we dealing with>>                    <<06212>>40365000
                                                               <<06212>>40370000
cacheddomain := codeseg := dataseg' := false;                  <<06613>>40375000
                                                               <<06212>>40380000
if objid(objidtypefield)= objiddatatype then dataseg':= true   <<07320>>40385000
else                                                           <<07320>>40390000
   if objid(objidtypefield)= objidcdtype then                  <<07320>>40395000
      begin <<cached disc domain>>                             <<06212>>40400000
      cacheddomain := true;                                    <<06212>>40405000
      cdtentrynumber := objid(objidnumfield);                  <<06660>>40410000
      end                                                      <<06660>>40415000
                                                               <<06411>>40420000
   else codeseg := true;                                       <<07320>>40425000
disable; <<in case background write completes during recovery>><<06212>>40430000
                                                               <<06212>>40435000
<<clear the roc flag, set the present flag>>                   <<06212>>40440000
                                                               <<06212>>40445000
if cacheddomain then                                           <<06212>>40450000
   begin <<roc flag is in the region header and in cdt entry>> <<06212>>40455000
   if gclassenabledmask.class0 then                            <<06411>>40460000
      if updatestatistics(measclass0,meassubclass0,measentry1, <<06411>>40465000
                c'cacherecovery,notnewvalue,1d,notdouble)      <<06411>>40470000
      <> 0 then suddendeath(sfkerncacheintbad);                <<06411>>40475000
   tos:=ocregionbase;                                          <<06212>>40480000
   tos:=tos+rbtosasdisp;                                       <<06212>>40485000
   asmb(lsea);                                                 <<06212>>40490000
   tos.regrocflag := 0;                                        <<06212>>40495000
   if = then suddendeath(sfkerncacheintbad);                   <<06212>>40500000
   asmb(ssea;ddel);                                            <<06212>>40505000
   if cdtentrynumber <> 0 then                                 <<06212>>40510000
      begin  <<cached disc domain is mapped in>>               <<06212>>40515000
      if cdt'set'bit(objid(objidnumfield),cdt'roc'bit,0)<>1    <<06660>>40520000
      then suddendeath(sfkerncachesyncbad);                    <<06212>>40525000
      end;                                                     <<06212>>40530000
   tos:=ocregionbase;                                          <<06212>>40535000
   end                                                         <<06212>>40540000
else                                                           <<06212>>40545000
   begin  <<segment>>                                          <<06212>>40550000
   x:=segdescstinx+dstsysbaseinx;                              <<06212>>40555000
   segdescflags.rocflag:=0;                                    <<06212>>40560000
   if = then suddendeath(619);                                 <<06212>>40565000
   tos:=segdescbank; <<bank>>                                  <<06212>>40570000
   tos:=segdescaddr;     <<seg base>>                          <<06212>>40575000
   asmb(ddup);                                                 <<06212>>40580000
   ocregionbase:=tos;<<fill in the regbase parm for segs>>     <<06212>>40585000
                                                               <<06212>>40590000
   <<kill backgorund write if dataseg>>                        <<06212>>40595000
                                                               <<06212>>40600000
   if dataseg' then                                            <<06613>>40605000
      begin <<try to kill ongoing write>>                      <<06212>>40610000
      tos:=tos+rbtowreqpdisp;                                  <<06212>>40615000
      asmb(lsea);                                              <<06212>>40620000
      if = then                                                <<06212>>40625000
         begin                                                 <<06212>>40630000
         if not logical(dst(segdescstinx+1)).disccopyvalidflag <<06212>>40635000
         then suddendeath(618);                                <<06212>>40640000
         asmb(del);                                            <<06212>>40645000
         end                                                   <<06212>>40650000
      else                                                     <<06212>>40655000
         begin                                                 <<06212>>40660000
         if logical(dst(segdescstinx+1)).disccopyvalidflag     <<06212>>40665000
         then suddendeath(618);                                <<06212>>40670000
         discqmanager(*,abortreqcode);<<abort write>>          <<06212>>40675000
         if < then suddendeath(618);                           <<06212>>40680000
         tos:=0;                                               <<06212>>40685000
         asmb(ssea); <<wipe out reference to that reqp>>       <<06212>>40690000
         end;                                                  <<06212>>40695000
      dst(segdescstinx+1).disccopyvalidflag:=0;<<mark dirty>>  <<06212>>40700000
      tos:=tos+wreqptorbdisp;                                  <<06212>>40705000
      end;                                                     <<06212>>40710000
   end;                                                        <<06212>>40715000
                                                               <<06212>>40720000
enable;                                                                 40725000
                                                                        40730000
<<locate the beginning of the available region of                       40735000
  which the segment being recovered is a part>>                         40740000
                                                                        40745000
if ls0 <= headerlength then                                             40750000
   begin  <<the object is at the front of the bank>>           <<06212>>40755000
   asmb(del);                                                           40760000
   tos:=rastorsdisp; <<addr of rs cell>>                                40765000
   end                                                                  40770000
else                                                                    40775000
   begin  <<object in the middle of an avail reg>>             <<06212>>40780000
                                                                        40785000
   lookback:  <<see if previous subregion in bank is avail>>            40790000
                                                                        40795000
   tos:=tos+rbtoptrasdisp;<<address of prev reg state>>                 40800000
   asmb(lsea);                                                          40805000
   tos.regavailableflag:=0;                                             40810000
   asmb(del);                                                           40815000
   if = then tos:=tos+ptrastorsdisp <<got to beginning>> else           40820000
      begin  <<preceding seg part of the avail reg>>                    40825000
      tos:=tos+trastotssdisp;                                           40830000
      asmb(lsea);                                                       40835000
      tos:=tos&lsl(pagepower);<<prev subregion's size>>                 40840000
      s1:=s1+ptsstorbdisp;                                              40845000
      asmb(sub);                                                        40850000
      if ls0 > headerlength then go lookback else                       40855000
         begin <<available region is first region in bank>>             40860000
         asmb(del);                                                     40865000
         tos:=rastorsdisp; <<addr of rs cell>>                          40870000
         end;                                                           40875000
      end;                                                              40880000
   end;                                                                 40885000
                                                                        40890000
<<the abs address of the region size cell of the region                 40895000
  header of which the oc is a part is on tos>>                          40900000
                                                                        40905000
<<                                                                      40910000
take the entire available region off the available region list          40915000
>>                                                                      40920000
                                                                        40925000
asmb(lsea);                                                             40930000
regionsize:=tos;                                                        40935000
tos:=tos+rstorbdisp;                                                    40940000
regionbase:=tos;                                                        40945000
tos:=ocregionbase-regionbase;                                  <<06212>>40950000
asmb(xch,del);                                                          40955000
if <> then suddendeath(614);                                   <<01644>>40960000
sizebelow:=tos&lsr(pagepower);                                          40965000
takeoffarl(regionbase,regionsize);                                      40970000
                                                                        40975000
<<                                                                      40980000
fix up header                                                           40985000
>>                                                                      40990000
                                                                        40995000
tos:=ocregionbase;                                             <<06212>>41000000
tos:=tos+rbtossdisp;                                                    41005000
asmb(lsea);                                                             41010000
segalloc:=tos;                                                          41015000
tos:=tos+sstorsdisp;                                                    41020000
tos:=segalloc;                                                          41025000
asmb(ssea); <<new region size>>                                         41030000
tos:=tos+rstorasdisp;                                                   41035000
tos:=regassignedcode;                                                   41040000
asmb(ssea);                                                             41045000
                                                                        41050000
<<                                                                      41055000
return the region below seg                                             41060000
>>                                                                      41065000
                                                                        41070000
if sizebelow <> 0  then                                                 41075000
   begin <<oc is in the middle of an ar,return prev to arl>>            41080000
   tos:=regionbase;                                                     41085000
   tos:=tos+rbtorsdisp;                                                 41090000
   tos:=sizebelow;                                                      41095000
   asmb(ssea;ddel);                                                     41100000
   tos:=ocregionbase;                                          <<06212>>41105000
   tos:=tos+rbtoptrsdisp;                                               41110000
   tos:=sizebelow;                                                      41115000
   asmb(ssea);                                                          41120000
   tos:=tos+trstotrasdisp;                                              41125000
   tos:=regavailablecode;                                               41130000
   asmb(ssea;ddel);                                                     41135000
   releaseregion(regionbase,0);                                         41140000
   end;                                                                 41145000
                                                                        41150000
                                                                        41155000
<<                                                                      41160000
fix up trailer                                                          41165000
>>                                                                      41170000
                                                                        41175000
tos:=tos+rastoptrasdisp+segalloc&lsl(pagepower);                        41180000
tos:=regassignedcode;                                                   41185000
asmb(ssea);                                                             41190000
tos:=tos+trastotrsdisp;                                                 41195000
tos:=segalloc;                                                          41200000
asmb(ssea);                                                             41205000
                                                                        41210000
<<                                                                      41215000
release region above                                                    41220000
>>                                                                      41225000
                                                                        41230000
x:=sizeabove:=regionsize-(segalloc+sizebelow);                          41235000
if < then suddendeath(614);                                    <<01644>>41240000
if > then                                                               41245000
   begin <<return portion of region above to arl>>                      41250000
   tos:=tos+ptrstorasdisp;                                              41255000
   tos:=regavailablecode;                                               41260000
   asmb(ssea);                                                          41265000
   tos:=tos+rastorsdisp;                                                41270000
   tos:=sizeabove;                                                      41275000
   asmb(ssea);                                                          41280000
   tos:=tos+rstorbdisp;                                                 41285000
   asmb(ddup);                                                          41290000
   tos:=tos+rbtoptrsdisp;                                               41295000
   tos:=tos+sizeabove&lsl(pagepower);                                   41300000
   tos:=sizeabove;                                                      41305000
   asmb(ssea;ddel);                                                     41310000
   releaseregion(*,0);                                                  41315000
   end;                                                                 41320000
                                                                        41325000
<<now mark the object present>>                                <<06212>>41330000
                                                               <<06212>>41335000
disable;                                                       <<01788>>41340000
                                                               <<06212>>41345000
if cacheddomain then                                           <<06212>>41350000
   begin <<cached disc domain has present bit in cdt entry>>   <<06212>>41355000
   if cdtentrynumber <> 0 then                                 <<06212>>41360000
      begin <<cached disc domain is mapped in >>               <<06212>>41365000
      if cdt'set'bit(objid(objidnumfield),cdt'abs'bit,0) <> 1  <<06660>>41370000
      then suddendeath(sfkerncachesyncbad);                    <<06212>>41375000
      end;                                                     <<06212>>41380000
   end                                                         <<06212>>41385000
else                                                           <<06212>>41390000
   begin  <<segment has pres bit in seg desc>>                 <<06212>>41395000
   dst(segdescstinx).absentflag:=0;                            <<06212>>41400000
   if = then suddendeath(619);  <<already present?>>           <<06212>>41405000
   end;                                                        <<06212>>41410000
                                                               <<06212>>41415000
                                                               <<06212>>41420000
<<check for break points set against a code segment>>          <<06212>>41425000
                                                               <<06212>>41430000
                                                                        41435000
if codeseg then                                                <<07320>>41440000
   begin  <<codeseg>>                                          <<06212>>41445000
   tos := curprc;                                              <<06650>>41450000
   if = then asmb(del) else                                             41455000
      begin                                                             41460000
      pcbpt := curprc;                                         <<06650>>41465000
      tos := bptlink;                                          <<06650>>41470000
      if = then asmb(del) else                                          41475000
         begin <<see if current process has a bkpt in objident><<06212>>41480000
         bptinx:=tos;                                          <<mm.iv>>41485000
         setsegsbkpts(obj,segdescstinx,bptinx);                <<06660>>41490000
         end;                                                           41495000
      end;                                                              41500000
   if sys'bkpt then setsegsbkpts(obj,segdescstinx,             <<06660>>41505000
                                 sys'bkpt'ext'x);              <<mm.iv>>41510000
   end;                                                                 41515000
                                                                        41520000
                                                               <<06212>>41525000
<<reenable pndg disc requests if a dataseg>>                   <<06212>>41530000
                                                               <<06212>>41535000
                                                                        41540000
if dataseg' then                                               <<06613>>41545000
   begin                                                                41550000
   if dqh'disahead <> 0 then                                   <<07320>>41555000
      checkfordeferreddiscreq(obj);                            <<06627>>41560000
   end;                                                                 41565000
end   <<recoveroc>>;                                                    41570000
                                                                        41575000
$page "MEMORY ALLOCATION PROCEDURES : ADDTOLOCALITY"                    41580000
                                                                        41585000
procedure addtolocality(sllheadinx,objidentifier,flags);       <<06625>>41590000
value sllheadinx,objidentifier,flags;                          <<06625>>41595000
integer sllheadinx,flags;                                      <<06625>>41600000
double objidentifier;                                          <<06660>>41605000
option privileged,uncallable;                                           41610000
                                                                        41615000
comment                                                                 41620000
                                                                        41625000
addtolocality is called from various places to get an object   <<06212>>41630000
placed into the locality of a process.  the flags parameter    <<06212>>41635000
determines : whether the sll's memory request pointer          <<06212>>41640000
should be pointed at the new entry, whether a lock             <<06212>>41645000
request (blocked or unblocked) is pending against the obj      <<06212>>41650000
for the process, whether a freeze request is pending           <<06212>>41655000
against the seg for the process, whether a wake-up disc        <<06212>>41660000
i/o request against the seg has been issued on behalf of the            41665000
process, or whether the sllentry should be flagged as a prefetc<<06212>>41670000
request.                                                       <<06212>>41675000
if the object is already on its way in for the process,        <<06411>>41680000
the cc is set to ccl, otherwise set to cce.                    <<06411>>41685000
ccg is returned if the noimpede bit in the flags is set and    <<h7928>>41690000
there are no sll entries currently available. it is the        <<h7928>>41695000
caller's responsability to handle this situation.              <<h7928>>41700000
                                                               <<h7928>>41705000
                                                               <<06411>>41710000
format of the flags parameter:                                 <<06625>>41715000
                                                               <<06625>>41720000
    (0:1)  - set memory request pointer                        <<06625>>41725000
    (1:1)  - set disc i/o pending flag                         <<06625>>41730000
    (2:1)  - set process's stack flag                          <<06625>>41735000
    (3:1)  - set db at segment flag                            <<06625>>41740000
    (4:1)  - set blk lk flag                                   <<06625>>41745000
    (5:1)  - set lock flag                                     <<06625>>41750000
    (6:1)  - set freeze flag                                   <<06625>>41755000
    (14:1) - call getsystabentry with nowait                   <<07320>>41760000
                                                               <<06625>>41765000
;                                                              <<06411>>41770000
                                                                        41775000
                                                                        41780000
                                                               <<06660>>41785000
begin                                                                   41790000
                                                               <<06625>>41795000
logical lflags = flags;                                        <<07320>>41800000
logical impede'me'flag;                                        <<h7928>>41805000
logical array objectid(*) = objidentifier;                     <<06660>>41810000
double sll'objid;      << object id from the sll >>            <<06660>>41815000
                                                               <<06660>>41820000
logical memreq:=false;                                                  41825000
                                                               <<06625>>41830000
                                                               <<06625>>41835000
integer objsinx,                                               <<06625>>41840000
        sllinx,       << index to regular sll entry >>         <<06625>>41845000
        objsentryinx;                                          <<06212>>41850000
                                                                        41855000
<<                                                                      41860000
db assumed to be pointing to sysdb                                      41865000
>>                                                                      41870000
                                                                        41875000
                                                                        41880000
<<flip thru the list and see if already an entry for the obj>> <<06212>>41885000
                                                                        41890000
disable; <<cause added/deleted on ics too>>                    <<06411>>41895000
impede'me'flag := if lflags.noimpede or                        <<h7928>>41900000
                     ics(-ics'pdiscntcell) > 0                 <<h7928>>41905000
                  then false else true;                        <<h7928>>41910000
                                                               <<h7928>>41915000
sllinx := sll(firstinx);                                       <<06625>>41920000
                                                               <<06411>>41925000
tos := sll(sll'objdesc);                                       <<06660>>41930000
tos := sll(sll'objnum);                                        <<06660>>41935000
sll'objid := tos;                                              <<06660>>41940000
                                                               <<06660>>41945000
while sllinx <> 0  and  sll'objid <> objidentifier do          <<06660>>41950000
   begin                                                       <<06660>>41955000
   sllinx := sll(nextinx);                                     <<06660>>41960000
   tos := sll(sll'objdesc);                                    <<06660>>41965000
   tos := sll(sll'objnum);                                     <<06660>>41970000
   sll'objid := tos;                                           <<06660>>41975000
   end;                                                        <<06660>>41980000
                                                               <<06625>>41985000
if sllinx <> 0 then objsinx := sllinx else                     <<06625>>41990000
   begin << no entry yet, so build one and put at head>>                41995000
                                                               <<07320>>42000000
   << do not want to wait for sll entry if called from disp. >><<07320>>42005000
                                                               <<07320>>42010000
   objsinx := getsystabentry(slldst,false,impede'me'flag);     <<h7928>>42015000
   if objsinx = 0 then                                         <<07320>>42020000
      if lflags.noimpede then                                  <<*7822>>42025000
         begin                                                 <<*7822>>42030000
         cc := ccg;                                            <<*7822>>42035000
         return;                                               <<*7822>>42040000
         end                                                   <<*7822>>42045000
      else suddendeath(602);                                   <<07320>>42050000
   sll(segcount) := sll(segcount) + 1;                         <<06625>>42055000
   tos := sll(firstinx);                                       <<06625>>42060000
   sll(firstinx) := objsinx;                                   <<06625>>42065000
   sllinx := objsinx;                                          <<06625>>42070000
   sll(nextinx) := s0;                                         <<06625>>42075000
   tos := objidentifier;                                       <<06660>>42080000
   sll(sll'objnum) := tos;                                     <<06660>>42085000
   sll(sll'objdesc) := tos;                                    <<06660>>42090000
   sllinx := tos;                                              <<06625>>42095000
   sll(previnx) := objsinx;                                    <<06625>>42100000
   end;                                                                 42105000
                                                                        42110000
<<do anything special as required by the flags parameter>>              42115000
                                                                        42120000
lflags.noimpede := 0;    << don't need this bit anymore >>     <<07320>>42125000
sllinx := objsinx;                                             <<06625>>42130000
if sll(sll'flags).sllimiflag then cc:=ccl else cc:=cce;        <<06625>>42135000
tos:=flags;                                                             42140000
asmb(test);                                                             42145000
if <> then                                                              42150000
   begin <<some special state of allocation>>                           42155000
   tos.setmemreqptrflag:=0;                                             42160000
   if <> then                                                           42165000
      begin                                                             42170000
      memreq:=true;                                                     42175000
      sll(memreqinx) := objsinx;                               <<06625>>42180000
      end;                                                              42185000
   tos.setdeccntflag:=0;                                       <<06945>>42190000
   if <> then sll(sll'flags).slldeccntflag := 1;               <<06945>>42195000
   asmb(test);                                                          42200000
   if <> then                                                           42205000
      begin                                                             42210000
      tos.setdisciosegflag:=0;                                          42215000
      if <> then                                                        42220000
         begin                                                          42225000
         sll(sll'flags).slldisciosegflag := 1;                 <<06625>>42230000
          tos := sll(sll'flags).sllprefetchcount;              <<*7577>>42235000
          if s0 = maxprefetchcount then suddendeath(619);      <<*7577>>42240000
          tos := tos + 1;                                      <<*7577>>42245000
          sll(sll'flags).sllprefetchcount := tos;              <<*7577>>42250000
         end;                                                           42255000
      asmb(test);                                                       42260000
      if <> then                                                        42265000
         begin                                                          42270000
         tos.procsstkflag:=0;                                           42275000
         if <> then sll(sll'flags).sllstkentryflag := 1;       <<06625>>42280000
         asmb(test);                                                    42285000
         if <> then                                                     42290000
            begin                                                       42295000
            tos.setlockflag:=0;                                         42300000
            if <> then sll(sll'flags).slllkreqflag := 1;       <<06625>>42305000
            asmb(test);                                                 42310000
            if <> then                                                  42315000
               begin                                                    42320000
               tos.setblklkflag:=0;                                     42325000
               if <> then sll(sll'flags).sllblklockreqflag:=1; <<06625>>42330000
               asmb(test);                                              42335000
               if <> then                                               42340000
                  begin                                                 42345000
                  tos.setfzflag:=0;                                     42350000
                  if <> then sll(sll'flags).sllfzreqflag := 1; <<07320>>42355000
                  asmb(test);                                  <<06104>>42360000
                  if <> then                                   <<06104>>42365000
                     begin                                     <<06104>>42370000
                     tos.setmapsegflag := 0;                   <<06104>>42375000
                     if <> then                                <<07320>>42380000
                     sll(sll'flags).sllmapsegflag := 1;        <<06625>>42385000
                                                               <<06411>>42390000
                     asmb(test);                               <<07320>>42395000
                     if <> then                                <<07320>>42400000
                        begin                                  <<07320>>42405000
                        tos.bumpprefetchcntflag:=0;            <<07320>>42410000
                        if = then suddendeath(619);            <<07320>>42415000
                        if sll(sll'flags).sllprefetchcount     <<07320>>42420000
                           = maxprefetchcount                  <<07320>>42425000
                        then suddendeath(sfkerncachesyncbad);  <<07320>>42430000
                        sll(sll'flags).sllprefetchcount :=     <<07320>>42435000
                           sll(sll'flags).sllprefetchcount + 1;<<07320>>42440000
                        end;                                   <<07320>>42445000
                     end;                                      <<07320>>42450000
                  end;                                                  42455000
               end;                                                     42460000
            end;                                                        42465000
         end;                                                           42470000
      end;                                                              42475000
   end;                                                                 42480000
end  <<procedure addtolocality>>;                                       42485000
$page "Memory Allocation Procedures : Pre Fetch Object"        <<06212>>42490000
                                                               <<06212>>42495000
procedure prefetchobject(pin, obj);                            <<06660>>42500000
value pin, obj;                                                <<06660>>42505000
integer pin;                                                   <<06212>>42510000
double  obj;                                                   <<06660>>42515000
option privileged,uncallable;                                  <<06212>>42520000
                                                               <<06212>>42525000
comment                                                        <<06212>>42530000
                                                               <<06212>>42535000
prefetchobject adds the object to the specified process' sll   <<06212>>42540000
and bumps the prefetch count of the object in the specified    <<06212>>42545000
process' sll entry for the object.                             <<06212>>42550000
                                                               <<06212>>42555000
if the object is not present, the process requiring the prefetc<<06212>>42560000
is flagged absent if not the current process and waited if the <<06212>>42565000
current process.                                               <<06212>>42570000
                                                               <<06212>>42575000
if the object is present: if the object is a mapped disc domain<<06212>>42580000
the cdt queue processor is invoked to attempt a cache move- in <<06212>>42585000
any case for a present object, the caller is returned to, and  <<06212>>42590000
nobody is flagged absent.                                      <<06212>>42595000
                                                               <<06212>>42600000
a prefetch causes the memory manager to initiate an object     <<06212>>42605000
fetch.    the process may be relaunched before the object      <<06212>>42610000
arrives.                                                       <<06212>>42615000
                                                               <<06212>>42620000
prefetchobject is called from the cache management system to   <<06212>>42625000
associate a mapped disc domain with a process and to initiate  <<06212>>42630000
a fetch of the indicated disc domain.  prefetchobject could    <<06212>>42635000
also be called in other circumstances in which an unblocked    <<06212>>42640000
segment fetch is required.                                     <<06212>>42645000
                                                               <<06212>>42650000
 when the object is no longer required, the prefetch should be <<06212>>42655000
offset by a call to adjustlocality which will decrement the    <<06212>>42660000
prefetch count in the sll list of the process for the specified<<06212>>42665000
object.                                                        <<06212>>42670000
                                                               <<06212>>42675000
prefetchobject assumes the current process is the one requestin<<06212>>42680000
that the prefetch be performed if the pin parameter is zero.   <<06212>>42685000
                                                               <<06212>>42690000
a non-zero prefetch count for an object in an sll list locks   <<06212>>42695000
the entry in the process'  sll list and causes the object to   <<06212>>42700000
continue to get prefetched until the prefetch count falls to   <<06212>>42705000
zero via offsetting calls in adjustlocality.                   <<06212>>42710000
                                                               <<06212>>42715000
;                                                              <<06212>>42720000
                                                               <<06212>>42725000
                                                               <<06212>>42730000
begin                                                          <<06212>>42735000
logical flags := false;                                        <<06411>>42740000
integer swapflags:=0, <<softswap,no wakeup>>                   <<06411>>42745000
        pcbpt;                                                 <<06650>>42750000
logical array objid(*)=obj;                                    <<06660>>42755000
integer sllheadinx;                                            <<06625>>42760000
integer segdescstinx;                                          <<06212>>42765000
integer iostatus;                                              <<06212>>42770000
double regionbase;                                             <<06212>>42775000
double  savedb;                                                <<06212>>42780000
                                                               <<06212>>42785000
                                                               <<06212>>42790000
<<set up environment>>                                         <<06212>>42795000
                                                               <<06212>>42800000
turnofftraps;                                                  <<06212>>42805000
pdisable;                                                      <<06212>>42810000
disable;                                                       <<06411>>42815000
tos:=%1000d;                                                   <<06212>>42820000
asmb(xchd);                                                    <<06212>>42825000
savedb:=tos;                                                   <<06212>>42830000
                                                               <<06212>>42835000
if pin = 0 then pin := (pcbpt := curprc/pcbsize)               <<06945>>42840000
else pcbpt := pin * pcbsize;                                   <<06945>>42845000
                                                               <<06945>>42850000
<<add object to process' sll with prefetch>>                   <<06212>>42855000
sllheadinx := sllptr;                                          <<06650>>42860000
flags.setmemreqptrflag:=1;                                     <<06411>>42865000
flags.bumpprefetchcntflag := 1;                                <<06212>>42870000
addtolocality(sllheadinx,obj,flags);                           <<06660>>42875000
                                                               <<06411>>42880000
if isobjectabsent(obj) and not isobjectimi(obj) then           <<06660>>42885000
   begin <<must get the object fetch initiated>>               <<06411>>42890000
   if swapin(pcbpt,swapflags) <> mmok then                     <<06650>>42895000
      begin <<initiate swapin through normal channels>>        <<06411>>42900000
      flagprocabsent(pin,obj,0);                                <<meas>>42905000
      end                                                      <<*8803>>42910000
   else     << swapin was successful >>                        <<*8803>>42915000
      waittodispmsg.memtrapflag := 0;                          <<*8803>>42920000
   end;                                                        <<06411>>42925000
                                                               <<06411>>42930000
                                                               <<06411>>42935000
                                                               <<s8699>>42940000
if not isobjectabsent(obj) then                                <<s8699>>42945000
   begin <<object already around>>                             <<06212>>42950000
   if objid(objidtypefield)= objidcdtype  then                 <<06660>>42955000
      begin <<disc cache hit>>                                 <<06212>>42960000
      cdt'abs'on'tos;                                          <<d7738>>42965000
      tos := tos + (objid(objidnumfield) * cdt'entry'size) +   <<d7738>>42970000
             cdt'md'mem'addr;                                  <<d7738>>42975000
      asmb(ldea;dxch,ddel);                                    <<d7738>>42980000
      << mapped domain memory address is on tos >>             <<d7738>>42985000
      tos:=tos+rbtosasdisp;                                    <<06212>>42990000
      asmb(lsea);                                              <<06212>>42995000
      iostatus:=tos.regfetchiostatus;                          <<06212>>43000000
      processcdtlogreqq(objid(objidnumfield),iostatus,0);      <<06660>>43005000
      end;                                                     <<06212>>43010000
   end;                                                        <<06411>>43015000
                                                               <<06411>>43020000
tos:=savedb;                                                   <<06212>>43025000
asmb(xchd);                                                    <<06212>>43030000
penable;                                                       <<06212>>43035000
                                                               <<06212>>43040000
end;  <<prefetchobject>>                                       <<06212>>43045000
$page "MEMORY ALLOCATION PROCEDURES : MAKE OVERLAY CANDIDATE"  <<06212>>43050000
                                                                        43055000
procedure makeoc(descstinx,obj,reqsize,regionbase);            <<06660>>43060000
value descstinx,obj,reqsize,regionbase;                        <<06660>>43065000
integer descstinx,reqsize;                                     <<06660>>43070000
double regionbase,obj;                                         <<06660>>43075000
option privileged,uncallable;                                           43080000
                                                                        43085000
comment                                                                 43090000
                                                                        43095000
makeoc releases the specified region to the pool of            <<06212>>43100000
available space.  makeoc is called from makeroom when the replacement   43105000
algorithm has been invoked and has selected an assigned region <<06212>>43110000
no longer being required by the current multiprogramming set.           43115000
also called from createlockspace when clearing out a lock region        43120000
                                                               <<06212>>43125000
                                                                        43130000
when invoked, makeoc releases the assigned main memory region  <<06212>>43135000
to the available region lists via a call to releaseregion.     <<06212>>43140000
                                                                        43145000
if the region being released is occupied by a cached disc      <<06212>>43150000
domain, the domain is flagged as an overlay candidate in the   <<06212>>43155000
subregion assignment state of the region header, and the domain<<06212>>43160000
cdt entry is marked absent, roc.                               <<06212>>43165000
                                                               <<06212>>43170000
if the region being made into an overlay candidate contains a  <<06212>>43175000
data segment,                                                  <<06212>>43180000
a write is queued into the background queue. when the region occupied   43185000
by the data segment is actually selected as the target for a segment    43190000
read, the priority of this segment write request gets bumped.           43195000
if the data segment is recovered, the write request will be aborted.    43200000
                                                                        43205000
;                                                                       43210000
                                                                        43215000
                                                                        43220000
begin                                                                   43225000
                                                                        43230000
logical array objident(*)=obj;                                 <<06660>>43235000
integer descsysdbinx,                                                   43240000
        mmbank=regionbase,                                     <<06212>>43245000
        mmbase=regionbase+1;                                   <<06212>>43250000
                                                                        43255000
                                                               <<06212>>43260000
                                                                        43265000
integer writreqsysdbinx,                                                43270000
        xfercount,                                                      43275000
        writedisabledcount:=0;                                          43280000
                                                                        43285000
                                                                        43290000
define pexit = assemble(exit 6)#;                              <<*7766>>43295000
                                                               <<*7766>>43300000
subroutine releaseseg;                                         <<06212>>43305000
                                                               <<06212>>43310000
begin                                                          <<06212>>43315000
                                                               <<06212>>43320000
x:=descsysdbinx:=descstinx+dstsysbaseinx;                               43325000
mmbank:=segdescbank; <<fill in the regionbase parm>>           <<06212>>43330000
mmbase:=segdescaddr;                                                    43335000
disable;                                                                43340000
if segdescflags.imiflag then suddendeath(619);                 <<01644>>43345000
<<trying to cancel a segment reservation-no longer allowed>>   <<01557>>43350000
if logical(segdescflags).segresidentflag                       <<01644>>43355000
then suddendeath(616) else                                     <<01644>>43360000
   begin <<seg not resident-make sure not locked,frozen,iofzn>>         43365000
   tos:=regionbase;                                                     43370000
   tos:=tos+rbtorasdisp;                                                43375000
   asmb(lsea);                                                          43380000
                                                               <<*7766>>43385000
   if ls0.regmapflag = 1 and not mempressure'cell then pexit;  <<*7766>>43390000
                                                               <<*7766>>43395000
   tos.reglkdflag:=0;                                                   43400000
   if <> then suddendeath(616) else                            <<01644>>43405000
      begin                                                             43410000
      tos.regfzflag:=0;                                                 43415000
      if <> then suddendeath(616) else                         <<01644>>43420000
         begin                                                          43425000
         tos.regiofzflag:=0;                                            43430000
         if <> then suddendeath(616) else                      <<01644>>43435000
            begin <<mark absent,flag as roc,release region,write>>      43440000
            asmb(del);                                                  43445000
            tos:=tos+rastosddisp;                                       43450000
            asmb(lsea);                                                 43455000
            tos.sdvalidflag:=0;                                         43460000
            asmb(ssea;ddel); <<signal writcomp nothing to do>> <<06212>>43465000
            x:=descsysdbinx;                                            43470000
            segdescflags.rocflag:=1; <<flag as oc in desc>>             43475000
            segdescfirminfo.absentflag:=1;                              43480000
            if <> then suddendeath(616) else                   <<01644>>43485000
            if objident(objidtypefield)=objiddatatype then     <<06660>>43490000
            startobjwrite(obj,bkgrndpri,regionbase,0,0);       <<06660>>43495000
            enable;                                                     43500000
            releaseregion(regionbase,reqsize);                          43505000
            end;                                                        43510000
         end;                                                           43515000
      end;                                                              43520000
   end;                                                        <<06212>>43525000
end; <<subroutine releaseseg>>                                 <<06212>>43530000
                                                               <<06212>>43535000
subroutine releasecacheddomain;                                <<06212>>43540000
                                                               <<06212>>43545000
begin                                                          <<06212>>43550000
                                                               <<06212>>43555000
<<mark domain as an overlay candidate>>                        <<06212>>43560000
                                                               <<06212>>43565000
tos:=regionbase;                                               <<06212>>43570000
tos:=tos+rbtosasdisp;                                          <<06212>>43575000
disable;                                                       <<06212>>43580000
asmb(lsea);                                                    <<06212>>43585000
tos.regrocflag := 1;                                           <<06212>>43590000
if <> then suddendeath(sfkerncachesyncbad);                    <<06212>>43595000
asmb(ssea);                                                    <<06212>>43600000
                                                               <<06212>>43605000
<<mark subregion disp invalid for write comp>>                 <<06212>>43610000
                                                               <<06212>>43615000
tos:=tos+sastosddisp;                                          <<06212>>43620000
asmb(lsea);                                                    <<06212>>43625000
tos.sdvalidflag:=0;                                            <<06212>>43630000
asmb(ssea;ddel);                                               <<06212>>43635000
                                                               <<06212>>43640000
<<mark cdt entry absent, roc if cached domain mapped in>>      <<06212>>43645000
                                                               <<06212>>43650000
if objident(objidnumfield)<> 0 then                            <<06660>>43655000
   begin <<cached disc domain has a cdt entry>>                <<06212>>43660000
   cdt'abs'on'tos;                                             <<d7738>>43665000
   tos := tos + (objident(objidnumfield) * cdt'entry'size) +   <<d7738>>43670000
          cdt'md'flags;                                        <<d7738>>43675000
   asmb(lsea);   << put flags word on tos >>                   <<d7738>>43680000
   tos.(cdt'roc'bit:1) := 1;                                   <<d7738>>43685000
   if <> then suddendeath(sfkerncachesyncbad);                 <<d7738>>43690000
   tos.(cdt'abs'bit:1) := 1;                                   <<d7738>>43695000
   if <> then suddendeath(sfkerncachesyncbad);                 <<d7738>>43700000
   asmb(ssea;ddel);  << store back flags word >>               <<d7738>>43705000
   end;                                                        <<06212>>43710000
<<now release the main memory region>>                         <<06212>>43715000
enable;                                                        <<06212>>43720000
releaseregion(regionbase,reqsize);                             <<06212>>43725000
                                                               <<06212>>43730000
end;  <<subroutine releasecacheddomain>>                       <<06212>>43735000
                                                               <<06212>>43740000
                                                               <<06212>>43745000
mmstat'(mmstatmakeoc,objident(objiddescfield),                 <<06948>>43750000
       objident(objidnumfield),mmbank,mmbase,0,0);             <<06948>>43755000
                                                               <<06212>>43760000
if objident(objidtypefield)=objidcdtype                        <<06660>>43765000
then releasecacheddomain                                       <<06212>>43770000
else releaseseg;                                               <<06212>>43775000
                                                               <<06212>>43780000
end  <<procedure makeoc>>;                                              43785000
$page "MEMORY ALLOCATION PROCEDURES : PUT PROCESS ON OBJ'S Q"  <<06212>>43790000
procedure putproconobjectsmpq(procpin,objident,regionbase,     <<06212>>43795000
   sllheadinx,sllinx,prefetchreq);                             <<06625>>43800000
value procpin,objident,regionbase,sllheadinx,sllinx,           <<06625>>43805000
   prefetchreq;                                                <<06411>>43810000
integer procpin,sllheadinx,sllinx;                             <<06625>>43815000
logical prefetchreq;                                           <<06660>>43820000
double objident,regionbase;                                    <<06660>>43825000
option privileged,uncallable;                                           43830000
                                                                        43835000
                                                                        43840000
comment                                                                 43845000
                                                                        43850000
putproconsegsmpq is called by fetchobject when a process requir<<06212>>43855000
segment which is already in motion in.  the process is queued           43860000
through the sll entries of the waiting processes.                       43865000
                                                                        43870000
;                                                                       43875000
                                                                        43880000
                                                                        43885000
begin                                                                   43890000
                                                               <<06660>>43895000
double sll'objid;                                              <<06660>>43900000
                                                               <<06660>>43905000
integer pcbpt;                                                 <<06751>>43910000
                                                               <<06660>>43915000
                                                               <<06625>>43920000
                                                               <<06625>>43925000
disable;                                                                43930000
if sll(sll'flags).sllimiflag  then suddendeath(613);           <<06625>>43935000
sll(sll'flags).sllimiflag := 1;                                <<06625>>43940000
if prefetchreq then sll(sll'flags).slldeccntflag := 0          <<06625>>43945000
else sll(sll'flags).slldeccntflag := 1;                        <<06625>>43950000
if not prefetchreq then                                        <<06411>>43955000
sll(schedtoiomsg):=sll(schedtoiomsg)+1;<< # i/os before awake>><<06625>>43960000
tos:=regionbase;                                                        43965000
tos:=tos+rbtompqlinkdisp;                                               43970000
asmb(lsea);                                                             43975000
if = then                                                               43980000
   begin <<first process waiting for this seg>>                         43985000
   asmb(del);                                                           43990000
   tos := procpin * pcbsize;                                   <<06660>>43995000
   asmb(ssea);                                                          44000000
   sll(nextimppin) := 0;                                       <<06625>>44005000
   end                                                                  44010000
else                                                                    44015000
   begin <<must link to tail>>                                          44020000
   sll(nextimppin) := 0;  << this guy is last >>               <<06751>>44025000
   asmb(delb,delb);       << del rb, save queue head >>        <<06751>>44030000
                                                               <<06751>>44035000
   while (pcbpt := tos) <> 0 do                                <<06751>>44040000
      begin                                                    <<06751>>44045000
      sllheadinx := integer(sllptr);                           <<06751>>44050000
      sllinx := sll(firstinx);                                 <<06751>>44055000
                                                               <<06751>>44060000
      tos := sll(sll'objdesc);                                 <<06751>>44065000
      tos := sll(sll'objnum);                                  <<06751>>44070000
      sll'objid := tos;                                        <<06751>>44075000
                                                               <<06751>>44080000
      while sll'objid <> objident do                           <<06751>>44085000
         begin                                                 <<06751>>44090000
         sllinx := sll(nextinx);                               <<06751>>44095000
         if = then suddendeath(2001);                          <<06751>>44100000
         tos := sll(sll'objdesc);                              <<06751>>44105000
         tos := sll(sll'objnum);                               <<06751>>44110000
         sll'objid := tos;                                     <<06751>>44115000
         end;                                                  <<06751>>44120000
                                                               <<06751>>44125000
      tos := sll(nextimppin);                                  <<06751>>44130000
      end;                                                     <<06751>>44135000
                                                               <<06751>>44140000
   sll(nextimppin) := procpin * pcbsize;                       <<06751>>44145000
   end;                                                                 44150000
end  <<procedure putproconobjectsmpq>>;                        <<06212>>44155000
                                                                        44160000
$page  "MEMORY ALLOCATION PROCEDURES : PUT DEVICE ON SEG'S Q"  <<06212>>44165000
procedure putdeviceonobjectsmpq(ioqinx,regionbase);            <<06620>>44170000
value ioqinx,regionbase;                                       <<06620>>44175000
integer ioqinx;                                                <<06620>>44180000
double regionbase;                                                      44185000
option privileged,uncallable;                                           44190000
                                                                        44195000
comment                                                                 44200000
                                                                        44205000
an entry from the special req table is used to maintain a list          44210000
of the devices in waiting the specified segment to arrive.  the         44215000
ioq relative index of this entry is kept in the segment's regio<<06620>>44220000
header.                                                                 44225000
                                                                        44230000
;                                                                       44235000
                                                                        44240000
begin                                                                   44245000
                                                                        44250000
define                                                         <<*7606>>44255000
   adisc   = logical(ioqinx).(1:1)#;                           <<*7606>>44260000
                                                               <<*7606>>44265000
integer                                                        <<06620>>44270000
   drq'entry'index,                                            <<*7606>>44275000
   full'entry'ptr;  << table rel. ptr to last full srt entry >><<06620>>44280000
                                                               <<06620>>44285000
double                                                         <<06620>>44290000
   savedb,         << db at entry/exit >>                      <<06620>>44295000
   sr'tabledb;     << db when at special request table >>      <<06620>>44300000
                                                                        44305000
                                                               <<*7606>>44310000
if adisc then                                                  <<*7606>>44315000
   begin                                                       <<*7606>>44320000
   drq'entry'index := ioqinx.(2:14);                           <<*7606>>44325000
   if drq'datafrzn or drq'done then return;                    <<*7606>>44330000
   end;                                                        <<*7606>>44335000
                                                               <<*7606>>44340000
tos := dst(specreqdst&lsl(2) + 2); << bank >>                  <<06616>>44345000
tos := dst(x + 1);                                             <<06616>>44350000
asmb(xchd);                                                    <<06616>>44355000
savedb := tos;                                                 <<06616>>44360000
tos:=regionbase;                                                        44365000
tos:=tos+rbtocompmsgdisp;                                               44370000
asmb(lsea);                                                             44375000
tos.compmsgiowakeflag:=1;                                               44380000
asmb(ssea);                                                             44385000
tos:=tos+compmsgtoioreqqdisp;                                           44390000
asmb(lsea);                                                             44395000
if = then                                                               44400000
   begin <<first device in line>>                                       44405000
   asmb(del);                                                           44410000
   x := getsystabentry(specreqdst,true,false); << p,nw >>      <<06616>>44415000
   if x=0 then suddendeath(600);<<spec req tab conf too small>>         44420000
   entryword01 := ioqinx;                                      <<06620>>44425000
   tos:=x;                                                              44430000
   asmb(ssea);       << table rel ptr to spec. req. entry >>   <<06620>>44435000
   end                                                                  44440000
else                                                                    44445000
   begin  <<must get in line>>                                          44450000
   x := tos;                                                   <<06620>>44455000
   while entryword00 <> 0 do                                   <<06620>>44460000
      begin      << this entry full already >>                 <<06620>>44465000
      x := entryword00;       << try next entry >>             <<06620>>44470000
      end;                                                     <<06620>>44475000
                                                               <<06620>>44480000
   if entryword01=0 then suddendeath(612);                     <<06620>>44485000
   if entryword02 = 0 then entryword02 := ioqinx               <<06620>>44490000
   else if entryword03 = 0 then entryword03 := ioqinx          <<06620>>44495000
   else if entryword04 = 0 then entryword04 := ioqinx          <<06620>>44500000
   else if entryword05 = 0 then entryword05 := ioqinx          <<06620>>44505000
   else                                                        <<06620>>44510000
      begin    << entry is now full -- get another >>          <<06620>>44515000
      disable;                                                 <<06620>>44520000
      full'entry'ptr := x;                                     <<06620>>44525000
      x := getsystabentry(specreqdst,true,false); << primary >><<06620>>44530000
      if x = 0 then suddendeath(600);                          <<06620>>44535000
      entryword00 := 0;    << new entry not full >>            <<06620>>44540000
      entryword01 := ioqinx;                                   <<06620>>44545000
      tos := x;            << new entry ptr >>                 <<06620>>44550000
      x := full'entry'ptr;                                     <<06620>>44555000
      entryword00 := tos;   << link previous to the new entry>><<06620>>44560000
      enable;                                                  <<06620>>44565000
      end;    << entry was full >>                             <<06620>>44570000
   end;                                                                 44575000
tos := savedb;                                                 <<06616>>44580000
asmb(xchd);                                                    <<06616>>44585000
ddel;                                                          <<06620>>44590000
end  <<putdeviceonobjectsmpq>>;                                <<06212>>44595000
                                                                        44600000
$page "MEMORY ALLOCATION PROCEDURES : ADJUSTLOCALITY"                   44605000
procedure adjustlocality(pcbpt,objident,reqsize,flags);        <<06650>>44610000
value pcbpt,objident,reqsize,flags;                            <<06650>>44615000
logical pcbpt,reqsize,flags;                                   <<06660>>44620000
double objident;                                               <<06660>>44625000
option privileged,uncallable;                                           44630000
                                                                        44635000
comment                                                                 44640000
                                                                        44645000
adjustlocality is called to make modifications to the locality          44650000
of a process.  the procedure makes a scan through the locality          44655000
list and performs the function indicated by the flags parameter.        44660000
the procedure is called from the following places to perform            44665000
the following functions :                                               44670000
   (i) siodm toclear the disc i/o seg flag against the segment          44675000
       for the process                                                  44680000
  (ii) from terminate to flush the locality list                        44685000
 (iii) from swap-in to initialize the locality list of a process        44690000
  (iv) from dispatcher to reference the minimal locality of a           44695000
       process when whipping hthrough the dispatching queue to          44700000
       keep that process' segs from getting eaten by the clock          44705000
       for less urgent processes.                                       44710000
   (v) from the cache move routine when the disc domain need no<<06212>>44715000
       be kept in the process' locality any longer (decs the   <<06212>>44720000
       prefetch count).                                        <<06212>>44725000
                                                               <<06625>>44730000
                                                               <<06625>>44735000
format of flags parameter:                                     <<06625>>44740000
                                                               <<06625>>44745000
     (1:1)  - init locallity list                              <<06625>>44750000
     (2:1)  - flush locallity list                             <<06625>>44755000
     (3:1)  - clear disc i/o pending flag                      <<06625>>44760000
     (8:1)  - release sll entry until there's room             <<06625>>44765000
     (9:1)  - reference min. locallity (for clock)             <<06625>>44770000
    (15:1)  - release sll entry                                <<06625>>44775000
                                                               <<06625>>44780000
;                                                                       44785000
                                                                        44790000
begin                                                                   44795000
                                                                        44800000
double                                                         <<06660>>44805000
   dbseg,                                                      <<06660>>44810000
   sll'objid;                                                  <<06660>>44815000
double lastrefswapseg;                                         <<06650>>44820000
logical foundit;                                               <<06660>>44825000
                                                               <<06625>>44830000
integer descstinx,                                                      44835000
        sllheadinx,      << index to sll header entry >>       <<06625>>44840000
        sllinx,                                                         44845000
        nextsllentryinx,                                                44850000
        sllentryinx,                                                    44855000
        memreqentryinx,                                        <<06625>>44860000
        count;                                                          44865000
                                                                        44870000
subroutine relsllentry;                                                 44875000
                                                                        44880000
begin                                                                   44885000
<<unlink entry from its sll>>                                           44890000
sllentryinx := sllinx;      << entry to be removed >>          <<06625>>44895000
sll(segcount) := sll(segcount) - 1;                            <<06625>>44900000
if integer(sll(memreqinx)) = sllentryinx then                  <<*7564>>44905000
   begin                                                       <<*7564>>44910000
   sll(memreqinx) := 0;                                        <<*7564>>44915000
   sll(schedtoiomsg).sllswapipflag := 0;                       <<*7564>>44920000
   end;                                                        <<*7564>>44925000
                                                               <<*7564>>44930000
tos := sll(nextinx);                                           <<06625>>44935000
tos := sll(previnx);                                           <<06625>>44940000
if sll(previnx) = 0 then                                       <<06625>>44945000
   begin <<first in list>>                                              44950000
   sll(firstinx) := s1;                                        <<06625>>44955000
   end                                                                  44960000
else                                                                    44965000
   begin                                                                44970000
   sllinx := tos;                                              <<06625>>44975000
   sll(nextinx) := s0;                                         <<06625>>44980000
   tos := sllinx;                                              <<06625>>44985000
   end;                                                                 44990000
                                                               <<06625>>44995000
asmb(xch);                                                     <<06625>>45000000
sllinx := tos;                                                 <<06625>>45005000
if sllinx <> 0 then sll(previnx) := tos  else asmb(del);       <<06625>>45010000
relsystabentry(slldst,sllentryinx);                            <<06625>>45015000
end  <<subroutine relsllentry>>;                                        45020000
                                                                        45025000
                                                                        45030000
foundit := false;                                              <<06212>>45035000
dbseg := double(dbxdsinfo.xdsdstfield);                        <<06660>>45040000
                                                               <<06660>>45045000
                                                               <<06660>>45050000
tos := lastrefcodeseg0;                                        <<06650>>45055000
tos := lastrefcodeseg1;                                        <<06650>>45060000
lastrefswapseg := tos;                                         <<06650>>45065000
sllheadinx := sllptr;                                          <<06625>>45070000
disable;                                                                45075000
memreqentryinx := sll(memreqinx);                              <<06625>>45080000
if flags.initlocflag then sll(schedtoiomsg).slllocinitflag:=1; <<06625>>45085000
if flags.rellocflag or flags.reltillroomflag                            45090000
   then sll(memreqinx) := sll(firstinx);                       <<06625>>45095000
sllinx := sll(firstinx);                                       <<06625>>45100000
while sllinx <> 0 do                                           <<06625>>45105000
   begin                                                                45110000
                                                               <<06660>>45115000
   tos := sll(sll'objdesc);                                    <<06660>>45120000
   tos := sll(sll'objnum);                                     <<06660>>45125000
   sll'objid := tos;                                           <<06660>>45130000
                                                               <<06660>>45135000
   tos:=flags;                                                          45140000
   asmb (trbc cleardiscsegbit);                                         45145000
   if <> then                                                           45150000
      begin                                                             45155000
      if objident <> sll'objid                                 <<06660>>45160000
         then nextsllentryinx := sll(nextinx)                  <<06625>>45165000
      else                                                              45170000
         begin                                                 <<*7577>>45175000
         tos := integer(sll(sll'flags).sllprefetchcount) - 1;  <<*7577>>45180000
         if = then                                             <<*7577>>45185000
            begin  << turn-off the discio pending bit >>       <<*7577>>45190000
                                                               <<06625>>45195000
            if not sll(sll'flags).slldisciosegflag then        <<*7577>>45200000
               suddendeath(619);                               <<*7577>>45205000
            sll(sll'flags).slldisciosegflag := 0;              <<*7577>>45210000
            end                                                <<*7577>>45215000
         else if < then suddendeath(619);<< too many decs >>   <<*7577>>45220000
         sll(sll'flags).sllprefetchcount := tos; <<new count >><<*7577>>45225000
         foundit := true;                                      <<06212>>45230000
         nextsllentryinx:=0;<<to terminate while loop>>                 45235000
         end;                                                           45240000
      end;                                                              45245000
   asmb(test);                                                          45250000
   if <> then                                                           45255000
      begin                                                             45260000
      asmb (trbc decprefetchcntbit);                           <<06212>>45265000
      if <> then                                               <<06212>>45270000
         begin                                                 <<06212>>45275000
         if objident <> sll'objid                              <<06660>>45280000
            then nextsllentryinx := sll(nextinx)               <<06625>>45285000
         else                                                  <<06212>>45290000
            begin                                              <<06212>>45295000
            tos := sll(sll'flags).sllprefetchcount;            <<*7564>>45300000
            tos := tos - 1;                                    <<06625>>45305000
            if < then suddendeath(619)                         <<*7564>>45310000
            else                                               <<*7564>>45315000
            if = then                                         <<<*7564>>45320000
               begin  << remove it from the locality >>        <<06411>>45325000
               sll(sll'flags).sllprefetchcount := tos;         <<*7564>>45330000
               relsllentry;                                    <<06411>>45335000
               end                                             <<06411>>45340000
            else                                               <<06625>>45345000
               begin                                           <<06625>>45350000
               sll(sll'flags).sllprefetchcount := tos;         <<*7564>>45355000
               end;                                            <<06411>>45360000
            nextsllentryinx:=0;<<to terminate while loop>>     <<06212>>45365000
            foundit := true;                                   <<06212>>45370000
            end;                                               <<06212>>45375000
         end;                                                  <<06212>>45380000
      asmb(trbc flushlocbit);                                           45385000
      if <> then                                                        45390000
         begin <<proc termination cleanup-release sll entries>>         45395000
         asmb(test);                                                    45400000
         if <> then suddendeath(619);                          <<01644>>45405000
         nextsllentryinx := sll(nextinx);  << for while loop >><<06625>>45410000
         objident := sll'objid;                                <<06660>>45415000
         relsllentry;                                                   45420000
         end;                                                           45425000
      asmb(trbc refminlocbit);                                          45430000
      if <> then                                                        45435000
         begin <<reference min locality for clock>>                     45440000
         if sllinx = memreqentryinx                            <<06625>>45445000
   << or sll(sll'flags).sllprefetchcount<>0 if include decode>><<06625>>45450000
            or sll'objid = dbseg or                            <<06660>>45455000
            sll(sll'flags).sllmapsegflag or                    <<06625>>45460000
            sll(sll'flags).sllstkentryflag or                  <<06625>>45465000
            sll(sll'flags).slldisciosegflag or                 <<06625>>45470000
            sll'objid = lastrefswapseg  then                   <<06660>>45475000
            begin <<in min locality>>                                   45480000
            if sll(sll'objdesc).objidtype = objidcdtype        <<06660>>45485000
               then descstinx := 0                             <<07320>>45490000
            else                                               <<07320>>45495000
            if sll(sll'objdesc).objidtype = objiddatatype      <<06660>>45500000
               then descstinx := sll(sll'objdesc) & lsl(2)     <<06660>>45505000
            else descstinx := convsegidtostinx(sll'objid);     <<06660>>45510000
            disable;                                                    45515000
            if descstinx <> 0 <<not a cached domain >>         <<06212>>45520000
            then dst(descstinx).referencedflag:=1;             <<06212>>45525000
            end;                                                        45530000
         nextsllentryinx := sll(nextinx);                      <<06625>>45535000
         end;                                                           45540000
      asmb(trbc initlocbit);                                            45545000
      if <> then                                                        45550000
         begin                                                          45555000
         asmb(test);                                                    45560000
         if <> then suddendeath(619);                          <<01644>>45565000
         nextsllentryinx := sll(nextinx); << for while loop >> <<06625>>45570000
         if sllinx <> memreqentryinx and                       <<06625>>45575000
            sll'objid <> dbseg  and                            <<06660>>45580000
            not sll(sll'flags).sllmapsegflag  and              <<06625>>45585000
            not sll(sll'flags).sllstkentryflag and             <<06625>>45590000
            not sll(sll'flags).slldisciosegflag and            <<06625>>45595000
         not sll(sll'flags).sllimiflag and                     <<06945>>45600000
            sll'objid <> lastrefswapseg and                    <<06660>>45605000
            sll(sll'flags).sllprefetchcount = 0 then           <<06625>>45610000
            begin<<not in min locality>>                                45615000
            relsllentry;                                                45620000
            end;                                                        45625000
         end;                                                           45630000
                                                               <<06754>>45635000
      asmb(trbc rellocbit);                                    <<06754>>45640000
      if <> then                                               <<06754>>45645000
         begin                                                 <<06754>>45650000
         if objident = sll'objid then                          <<06754>>45655000
            begin                                              <<06754>>45660000
            relsllentry;                                       <<06754>>45665000
            nextsllentryinx := 0;  << terminate while loop >>  <<06754>>45670000
            foundit := true;                                   <<06754>>45675000
            end                                                <<06754>>45680000
         else                                                  <<06754>>45685000
            nextsllentryinx := sll(nextinx);                   <<06754>>45690000
         end;                                                  <<06754>>45695000
                                                               <<06754>>45700000
      asmb(test,del); <<copy of flags that we gradually zeroed>>        45705000
      if <> then suddendeath(619);                             <<01644>>45710000
      end;                                                              45715000
   sllinx := nextsllentryinx;                                  <<06625>>45720000
   end;                                                                 45725000
if flags.flushlocflag <<toss the proc's sll header if dying>>           45730000
   then relsystabentry(slldst,sllheadinx);                     <<06625>>45735000
if (flags.cleardiscsegflag or flags.decprefetchcntflag)        <<06212>>45740000
   and (not foundit) then suddendeath(sfkerncachesyncbad);     <<06625>>45745000
if flags.rellocflag and not foundit then suddendeath(619);     <<06754>>45750000
end  <<procedure adjustlocality>>;                                      45755000
                                                                        45760000
$page "MEMORY ALLOCATION PROCEDURES : MAKEROOM"                         45765000
                                                                        45770000
logical procedure makeroom(procinx,reqsize,hardrequest);                45775000
value procinx,reqsize,hardrequest;                                      45780000
integer procinx,reqsize;                                                45785000
logical hardrequest;                                                    45790000
option privileged,uncallable;                                           45795000
                                                                        45800000
comment                                                        <<06212>>45805000
                                                               <<06212>>45810000
makeroom applies the relacement algorithm to free up space for <<06212>>45815000
for a pending fetch request.  makeroom tries to free up space  <<06212>>45820000
by releasing assigned regions until an available region of     <<06212>>45825000
size larger than the required size (as indicated by the reqsize<<06212>>45830000
parameter) is created, or until an activity more urgent that th<<06212>>45835000
priority of the process requiring the fetch becomes pending.   <<06212>>45840000
                                                               <<06212>>45845000
makeroom may also give up if thrash danger is detected.  this  <<06212>>45850000
type of giveup can be turned off by setting the hardreq parm   <<06212>>45855000
to true.                                                       <<06212>>45860000
                                                               <<06212>>45865000
makeroom applies the clock algorithm, cycling through memory,  <<06212>>45870000
turning off the reference bit associated with the region       <<06212>>45875000
where the scan point is currently located, and releasing       <<06212>>45880000
the segment or cached domain sitting in the region if the      <<06212>>45885000
referenec bit was found off.                                   <<06212>>45890000
                                                               <<06212>>45895000
the clock algorithm is currently applied uniformly for         <<06212>>45900000
segments and cached domains.  this may change in the tuning    <<06212>>45905000
process. (eg a separate clock ptr for replacing cached domains <<06212>>45910000
than the one for replacing segments)                           <<06212>>45915000
;                                                              <<06212>>45920000
                                                               <<06212>>45925000
begin                                                                   45930000
double currenttime,                                                     45935000
       obj,                                                    <<06660>>45940000
       nextregion,                                                      45945000
       tslcycled;                                                       45950000
integer descstinx;                                                      45955000
logical regflags,                                              <<06212>>45960000
        subregflags,                                           <<06212>>45965000
        ok,                                                             45970000
        currentstk:=false,                                     <<06945>>45975000
        currentdbseg:=false,                                   <<06945>>45980000
        need'it := false,                                      <<07320>>45985000
        currentmapseg := false,                                <<07320>>45990000
        giveup:=false;                                                  45995000
logical array objident(*)=obj;                                 <<06660>>46000000
                                                                        46005000
                                                                        46010000
                                                                        46015000
subroutine updatescanpoint;                                             46020000
                                                                        46025000
begin                                                                   46030000
ok:=false;                                                              46035000
tos:=scanpoint;                                                         46040000
tos:=tos+rbtorsdisp;                                                    46045000
asmb(lsea);                                                             46050000
if s0=maxholesize then s0:=-1 <<force carry>> else             <<01616>>46055000
   begin <<whole bank not free>>                               <<01799>>46060000
   tos:=tos&lsl(pagepower);                                    <<01616>>46065000
   tos:=tos+rstorbdisp;                                        <<01616>>46070000
   end;                                                        <<01616>>46075000
asmb(ladd);                                                             46080000
if nocarry then                                                         46085000
   begin <<in same bank>>                                               46090000
                                                                        46095000
   << locate next unavailable region in bank for                        46100000
      new scan point >>                                                 46105000
                                                                        46110000
   while not ok do                                                      46115000
      begin                                                             46120000
      <<check if half-bank>>                                            46125000
      asmb(ddup);                                                       46130000
      nextregion:=tos;                                                  46135000
      if nextregion >= lastmemoryaddress then go to nextbank;           46140000
      tos:=tos+rbtorasdisp;                                             46145000
      asmb(lsea);                                                       46150000
      regflags:=tos;                                           <<06212>>46155000
      if not regflags.regavailableflag then                    <<06212>>46160000
         begin                                                          46165000
         tos:=tos+rastorbdisp;                                          46170000
         scanpoint:=tos;                                                46175000
         ok:=true;                                                      46180000
         end                                                            46185000
      else                                                              46190000
         begin  <<must skip over this one>>                             46195000
         tos:=tos+rastorsdisp;                                          46200000
         asmb(lsea);                                                    46205000
         tos:=tos&lsl(pagepower);                                       46210000
         tos:=tos+rstorbdisp;                                           46215000
         asmb(ladd);                                                    46220000
         if carry then go to nextbank;                                  46225000
         end;                                                           46230000
      end;                                                              46235000
   end                                                                  46240000
else                                                                    46245000
   begin  <<last region in bank>>                                       46250000
                                                                        46255000
   nextbank:                                                            46260000
                                                                        46265000
   if s1=nbanks then                                                    46270000
      begin  <<cycled>>                                                 46275000
      asmb(ddel);                                                       46280000
      scanpoint:=firstmemaddr;                                          46285000
      lastcycleduration:=tslcycled;                                     46290000
      timeoflastcycle:=currenttime;                                     46295000
      if lastcycleduration < cyclethreshold and not hardrequest<<01987>>46300000
      then giveup := true;  <<afraid of thrashing>>            <<01987>>46305000
      if gclassenabledmask.class0 then                         <<ray.v>>46310000
         begin <<count # of cycles>>                           <<ray.v>>46315000
         tos:=measstatxdsbank;                                 <<ray.v>>46320000
         tos:=measstatxdsbase;                                 <<ray.v>>46325000
         tos:=tos+c0sub0'segreloff+c'clockcycle;               <<ray.v>>46330000
         asmb(lsea;inca;ssea;ddel);                            <<ray.v>>46335000
         end;                                                  <<ray.v>>46340000
      end                                                               46345000
   else                                                                 46350000
      begin                                                             46355000
      s1:=s1+1; <<bump to next bank>>                                   46360000
      s0:=headerlength;                                        <<01799>>46365000
      scanpoint:=tos;                                                   46370000
      end;                                                              46375000
   end;                                                                 46380000
end << subroutine updatescanpoint>>;                                    46385000
                                                                        46390000
                                                               <<01925>>46395000
hotimelastmakeroom:=trldtime1;                                 <<06943>>46400000
lotimelastmakeroom:=trldtime2;                                 <<06943>>46405000
currenttime:=timer;                                                     46410000
tslcycled:=currenttime-timeoflastcycle;                                 46415000
if lastcycleduration > cyclethreshold or tslcycled > cyclethreshold     46420000
or hardrequest then                                                     46425000
   begin  <<ok to make room>>                                           46430000
   if curprc <> 0 then                                         <<06945>>46435000
      begin <<mem mgt from stk==>fill in stk, db local var>>   <<06945>>46440000
      currentstk := ics(-ics'stkdstcell);                      <<06945>>46445000
      currentdbseg := pcb(curprc + dbxdsinfowordnum)           <<06945>>46450000
                           .xdsdstfield;                       <<06945>>46455000
      currentmapseg := pcb(curprc + mapdstwordnum);            <<07320>>46460000
      end;                                                     <<06945>>46465000
   while reqsize > maxavailreg and awaketoschedmsg >= curractpri        46470000
   and not giveup do                                                    46475000
      begin                                                             46480000
      if (dqh'tot'ent-dqh'cur'nuse) < 3 then                   <<06392>>46485000
         begin <<not enough disc request entries to procede>>  <<01987>>46490000
         makeroom:=mmoutofdiscreq;                             <<01987>>46495000
         return;                                               <<01987>>46500000
         end;                                                  <<01987>>46505000
      tos:=scanpoint;                                                   46510000
      tos:=tos+rbtorasdisp;                                             46515000
      disable; <<might i/o freeze before makeoc>>              <<01562>>46520000
      asmb(lsea);                                                       46525000
      regflags:=tos;                                           <<06212>>46530000
      if not regflags.regavailableflag                         <<06212>>46535000
      and not regflags.regreservedflag                         <<06212>>46540000
      and regflags.regnonmoveflags=0 then                      <<06212>>46545000
         begin <<this region can be overlayed-check usage>>    <<06212>>46550000
         tos:=tos+rastoobjidentdisp;                           <<06212>>46555000
         asmb(ldea);                                           <<06660>>46560000
                                                               <<06212>>46565000
         if = then suddendeath(614);                           <<06212>>46570000
         obj:=tos;                                             <<06660>>46575000
         tos:=tos+objidenttosasdisp;                           <<06212>>46580000
         asmb(lsea);                                           <<06212>>46585000
         subregflags:=tos;                                     <<06212>>46590000
         if subregflags.regcachedflag then                     <<06212>>46595000
            begin <<cached domain>>                            <<06212>>46600000
            subregflags.regrefflag:=0;                         <<06212>>46605000
            if = then  makeoc(0,obj,reqsize,scanpoint)         <<06660>>46610000
            else                                               <<06212>>46615000
               begin <<been used recently so skip it>>         <<06212>>46620000
               tos:=subregflags;                               <<06212>>46625000
               asmb(ssea); <<update reference bit>>            <<06212>>46630000
               end;                                            <<06212>>46635000
            end                                                <<06212>>46640000
         else                                                  <<06212>>46645000
            begin <<a segment is in this region>>              <<06212>>46650000
            if objident(objidtypefield)=objiddatatype          <<06660>>46655000
            then descstinx:=objident(objidnumfield)&lsl(2)     <<06660>>46660000
            else descstinx:=convsegidtostinx(obj);             <<06660>>46665000
            if not logical(dst(descstinx)).absentflag then     <<06212>>46670000
               begin <<seg is present>>                        <<06212>>46675000
               need'it := if                                   <<07320>>46680000
                   objident(objidtypefield) = objiddatatype and<<07320>>46685000
                   (objident(objidnumfield) = currentdbseg or  <<07320>>46690000
                    objident(objidnumfield) = currentstk or    <<07320>>46695000
                    objident(objidnumfield)=currentmapseg) then<<07320>>46700000
                       true else false;                        <<07320>>46705000
                                                               <<*7564>>46710000
               << check recent useage >>                       <<*7564>>46715000
               dst(descstinx).referencedflag := 0;             <<*7564>>46720000
               if = and not need'it then                       <<07320>>46725000
               <<can toss if ref bit off, not current proc's se<<06945>>46730000
                makeoc(descstinx,obj,reqsize,scanpoint);       <<06660>>46735000
               end                                             <<06212>>46740000
            else if dst(x:=x+1).fwipflag <> 1                  <<06212>>46745000
            then suddendeath(619);                             <<06212>>46750000
            end;                                               <<06212>>46755000
         end;                                                  <<06212>>46760000
      asmb(ddel);                                                       46765000
      enable;  <<offset disable>>                              <<01562>>46770000
      updatescanpoint;                                                  46775000
      end;                                                              46780000
   end;                                                                 46785000
if awaketoschedmsg < curractpri then makeroom := mmpreempt     <<d7738>>46790000
else if reqsize <= maxavailreg then makeroom:=mmok             <<01987>>46795000
else makeroom:=mmthrashdanger;                                 <<01987>>46800000
end  <<makeroom>>;                                                      46805000
                                                                        46810000
                                                                        46815000
$page "MEMORY ALLOCATION PROCEDURES : CREATE LOCK SPACE "               46820000
double procedure createlockspace(pagesrequired);                        46825000
value pagesrequired;                                                    46830000
integer pagesrequired;                                                  46835000
option privileged,uncallable;                                           46840000
                                                                        46845000
begin                                                                   46850000
                                                                        46855000
double searchbase,                                                      46860000
       obj,                                                    <<06660>>46865000
       searchpointer;                                                   46870000
integer descstinx,                                                      46875000
        cdtentrynumber,                                        <<06212>>46880000
        thisregionsize,                                                 46885000
        condcode:=cce,                                                  46890000
        potentialsize:=0;                                               46895000
logical mapseg;                                                <<*7766>>46900000
logical quit:=false;                                                    46905000
logical imi := false;                                          <<06212>>46910000
logical array objident(*)=obj;                                 <<06660>>46915000
subroutine bumpsearchbase;                                              46920000
                                                                        46925000
begin                                                                   46930000
potentialsize:=0;                                                       46935000
tos:=searchpointer;                                                     46940000
tos:=thisregionsize&lsl(pagepower);                                     46945000
asmb(ladd);                                                             46950000
if carry or thisregionsize = maxholesize then s1 := s1 + 1;    <<07320>>46955000
searchbase:=tos;                                                        46960000
searchpointer:=searchbase;                                              46965000
if searchbase > lastmemoryaddress then                                  46970000
   begin                                                                46975000
   quit:=true;                                                          46980000
   condcode:=ccg;                                                       46985000
   end;                                                                 46990000
end;                                                                    46995000
                                                                        47000000
subroutine bumpsearchpointer;                                           47005000
                                                                        47010000
begin                                                                   47015000
tos:=searchpointer;                                                     47020000
potentialsize:=potentialsize+thisregionsize;                            47025000
tos:=thisregionsize&lsl(pagepower);                                     47030000
asmb(ladd);                                                             47035000
if carry or thisregionsize = maxholesize then                  <<07320>>47040000
   begin <<woops-went off the end of the bank>>                         47045000
   asmb(ddel);                                                          47050000
   bumpsearchbase ;                                                     47055000
   end                                                                  47060000
else                                                                    47065000
   begin <<bump to next region in the bank>>                            47070000
   searchpointer:=tos;                                                  47075000
   if searchpointer > lastmemoryaddress then                            47080000
      begin                                                             47085000
      quit:=true;                                                       47090000
      condcode:=ccg;                                                    47095000
      end;                                                              47100000
   end;                                                                 47105000
end;                                                                    47110000
                                                                        47115000
                                                                        47120000
searchpointer:=searchbase:=firstmemaddr;                                47125000
while potentialsize < pagesrequired and not quit do                     47130000
   begin                                                                47135000
   tos:=searchpointer;                                                  47140000
   tos:=tos+rbtorsdisp;                                                 47145000
   disable;                                                             47150000
   asmb(lsea);                                                          47155000
   thisregionsize:=tos;                                                 47160000
   tos:=tos+rstorasdisp;                                                47165000
   asmb(lsea);                                                          47170000
   if ls0.regavailableflag then bumpsearchpointer                       47175000
   else if ls0.reglkdflag then bumpsearchbase                           47180000
   else if ls0.regfzflag then bumpsearchbase                            47185000
   else if ls0.regiofzflag then                                         47190000
      begin <<delay>>                                                   47195000
      <<condcode:=ccl;>>                                                47200000
      <<quit:=true;>>                                                   47205000
      bumpsearchbase ; <<damn lp driver won't i/o unfreeze>>            47210000
      end                                                               47215000
   else                                                                 47220000
      begin <<try to throw this object out>>                   <<06212>>47225000
      if ls0.regmapflag then mapseg:=true else mapseg:=false;  <<*7766>>47230000
      asmb(del);                                                        47235000
      tos:=tos+rastoobjidentdisp;                              <<06212>>47240000
      asmb(ldea);                                              <<06660>>47245000
      obj:=tos;                                                <<06660>>47250000
                                                               <<06212>>47255000
      <<see if object is in motion in>>                        <<06212>>47260000
                                                               <<06212>>47265000
      if objident(objidtypefield)=objidcdtype then             <<06660>>47270000
         begin <<a cached disc domain sitting here>>           <<06212>>47275000
         cdtentrynumber := objident(objidnumfield);            <<06660>>47280000
         if  <> then                                           <<06212>>47285000
            begin <<mapped in>>                                <<06212>>47290000
            if cdt'get'bit(cdtentrynumber,cdt'imi'bit,0) = 1   <<06212>>47295000
            then imi := true;                                  <<06212>>47300000
            end;                                               <<06212>>47305000
         end                                                   <<06212>>47310000
      else                                                     <<06212>>47315000
         begin << a segment>>                                  <<06212>>47320000
         if objident(objidtypefield)=objiddatatype             <<06660>>47325000
         then descstinx:=objident(objidnumfield)&lsl(2)<<dseg>><<06660>>47330000
         else descstinx:=convsegidtostinx(obj);                <<06660>>47335000
         if logical(dst(descstinx+1)).imiflag                  <<06212>>47340000
         then imi := true;                                     <<06212>>47345000
         end;                                                  <<06212>>47350000
                                                               <<06212>>47355000
      if imi then                                              <<06212>>47360000
         begin <<delay till read completes>>                            47365000
         condcode:=ccl;                                                 47370000
         quit:=true;                                                    47375000
         end                                                            47380000
      else                                                              47385000
         begin  <<throw the obj out>>                          <<06212>>47390000
         << if it's a mapseg then, let makeoc throw it out >>  <<*7766>>47395000
                                                               <<*7766>>47400000
         if mapseg then                                        <<*7766>>47405000
            begin                                              <<*7766>>47410000
            tos := mempressure'cell;                           <<*7766>>47415000
            mempressure'cell := 1;                             <<*7766>>47420000
            end;                                               <<*7766>>47425000
                                                               <<*7766>>47430000
         makeoc(descstinx,obj,0,searchpointer);                <<06660>>47435000
                                                               <<*7766>>47440000
         if mapseg then mempressure'cell := tos;               <<*7766>>47445000
         enable;                                                        47450000
         bumpsearchpointer;                                             47455000
         end;                                                           47460000
      end;                                                              47465000
   enable;                                                              47470000
   end;                                                                 47475000
                                                                        47480000
if not quit then createlockspace:=searchbase                            47485000
else createlockspace:=0d;                                               47490000
cc:=condcode;                                                           47495000
end  <<createlockspace>>;                                               47500000
                                                                        47505000
$page "MEMORY ALLOCATION PROCEDURES : FETCH OBJECT "           <<06212>>47510000
integer procedure fetchobject(obj,requestorid,                 <<06660>>47515000
   specialflags,specialinfo,hardrequest);                               47520000
value obj,requestorid,specialflags,specialinfo,                <<06660>>47525000
      hardrequest;                                             <<06212>>47530000
integer requestorid;                                                    47535000
logical specialflags,specialinfo,hardrequest;                  <<06660>>47540000
double obj;                                                    <<06660>>47545000
option privileged,uncallable;                                           47550000
                                                                        47555000
comment                                                                 47560000
                                                                        47565000
fetchobject is invoked by the dispatcher directly for a segment<<06212>>47570000
request from the i/o system, and from the dispatcher's subroutine       47575000
swapin for objects required by a process being swapped in.     <<06212>>47580000
                                                               <<06212>>47585000
                                                                        47590000
fetchobject checks the object's descriptor to see if the object<<06212>>47595000
is already present or on its way in on behalf of another proces<<06212>>47600000
if such is the case, no main memory allocation is required. if          47605000
the object is present, control returns immediately to the      <<06212>>47610000
caller.  if the segment is on its way in, the process' pcb              47615000
or the device's ldevnum is queued for the segment, and when             47620000
the read completes, the process' counter for read coompletions          47625000
until awake is decremented and if it falls to zero the process          47630000
is launched, or awakeio is called against the device for io requests.   47635000
                                                                        47640000
if the object is absent,an available main memory region is     <<06212>>47645000
reserved for the segment, or, if a large enough region is not           47650000
available, an attempt is made to makeroom.  if a region is              47655000
obtained, a read for the segment is formed.                    <<06212>>47660000
                                                               <<06212>>47665000
if the request is blocked, (ie not a prefetch request), the pro<<06212>>47670000
or device is queued for the object.                            <<06212>>47675000
                                                                        47680000
the i/o system finishes off the fetch on the ics.  when                 47685000
ongoing i/o completes in the region reserved for the                    47690000
object fetch, the read request is queued.  when the read       <<06212>>47695000
completes, the waiting processes and devices are awakened.              47700000
or a cache move is initiated in the case of a fetch of a mapped<<06212>>47705000
disc domain.                                                   <<06212>>47710000
                                                                        47715000
;                                                                       47720000
                                                                        47725000
begin                                                                   47730000
                                                               <<*7606>>47735000
define                                                         <<*7606>>47740000
  a'disc = logical(requestorid).(1:1)#;                        <<*7606>>47745000
                                                               <<*7606>>47750000
integer returnvalue=fetchobject;                               <<07320>>47755000
logical array objidentifier(*)=obj;                            <<06660>>47760000
<<db assumed to be at sysdb>>                                           47765000
                                                                        47770000
double regionbase,                                             <<06620>>47775000
       startsector,                                            <<06212>>47780000
       limitsector,                                            <<06212>>47785000
       mapd'abs'ofst,    << abs addr of mapped entry >>        <<d7738>>47790000
       ocregionbase;                                           <<06212>>47795000
                                                                        47800000
logical reqsize;                                                        47805000
                                                                        47810000
integer objsize,                                               <<06212>>47815000
        drq'entry'index,                                       <<06392>>47820000
        reqp,                                                  <<06392>>47825000
        iostatus,                                              <<06212>>47830000
        xfercnt,                                                        47835000
        pcbpt,                                                 <<06650>>47840000
        segdescstinx,                                                   47845000
        segdescsysbaseinx,                                              47850000
        hoda,                                                           47855000
        loda,                                                           47860000
        discreqinx,                                                     47865000
        count,                                                          47870000
        procpri,                                                        47875000
        sllinx,                                                <<06625>>47880000
        specreqinx,                                                     47885000
        mstatparm3,                                            <<06948>>47890000
        cdtentrynumber,                                        <<06212>>47895000
        readoffset:=0;                                                  47900000
                                                                        47905000
logical dataseg' := false,                                     <<06613>>47910000
        mappeddomain := false,                                 <<06212>>47915000
        swappingin:=false,                                              47920000
        segmodpndg:=false,                                              47925000
        iosysreq:=false,                                                47930000
        iofzreq:=false,                                                 47935000
        fzreq:=false,                                                   47940000
        lkreq:=false,                                                   47945000
        prefetchreq := false,                                  <<06212>>47950000
        present := false,                                      <<06212>>47955000
        roc := false,                                          <<06212>>47960000
        imi := false,                                          <<06212>>47965000
        bklkreq:=false,                                        <<06212>>47970000
        mapd'flags,      << local copy of mapped dom. flags >> <<d7738>>47975000
        regassignstate;                                        <<06212>>47980000
                                                               <<06212>>47985000
                                                               <<06212>>47990000
subroutine getda'putrb;                                        <<06212>>47995000
                                                               <<06212>>48000000
<<looks up the object's disc address and stuffs into h/loda>>  <<06212>>48005000
<<puts the regionbase into the object's desc>>                 <<06212>>48010000
                                                               <<06212>>48015000
begin                                                          <<06212>>48020000
if mappeddomain then                                           <<06212>>48025000
   begin                                                       <<06212>>48030000
   tos := mapd'abs'ofst;                                       <<d7738>>48035000
   << put db at mapped domain entry >>                         <<d7738>>48040000
   exchdb;                  << put db at entry >>              <<d7738>>48045000
   tos := cdt'darray(cdt'md'sector & asr(1));                  <<d7738>>48050000
                                                               <<d7738>>48055000
   loda := tos;                                                <<d7738>>48060000
   hoda := tos;                                                <<d7738>>48065000
   hoda.(0:8) := cdt'array(cdt'md'ldev);                       <<d7738>>48070000
   cdt'darray(cdt'md'mem'addr & asr(1)) := regionbase;         <<d7738>>48075000
   exchdb;   << put db back >>                                 <<d7738>>48080000
   asmb(ddel);  << remove abs addr >>                          <<d7738>>48085000
   end                                                         <<06212>>48090000
                                                               <<06212>>48095000
else                                                           <<06212>>48100000
   begin <<a seg>>                                             <<06212>>48105000
   x:=segdescsysbaseinx;                                       <<06212>>48110000
   hoda:=segdeschoda;                                          <<06212>>48115000
   loda:=segdescloda;                                          <<06212>>48120000
   tos :=regionbase;                                           <<06212>>48125000
   segdescaddr:=tos;                                           <<06212>>48130000
   segdescbank:=tos;                                           <<06212>>48135000
   end                                                         <<06212>>48140000
end;  <<subroutine getda'putrb>>                               <<06212>>48145000
                                                               <<06212>>48150000
subroutine initregionbasevar;                                  <<06212>>48155000
                                                               <<06212>>48160000
<<fills in the region base local variable from the seg desc>>  <<06212>>48165000
<<or the cdt entry of the object(object must be present)>>     <<06212>>48170000
                                                               <<06212>>48175000
begin                                                          <<06212>>48180000
if mappeddomain then                                           <<d7738>>48185000
   begin                                                       <<d7738>>48190000
   tos := mapd'abs'ofst;                                       <<d7738>>48195000
   tos := tos + cdt'md'mem'addr; << point to mem cell >>       <<d7738>>48200000
   asmb(ldea;dxch,ddel);  << load memory address >>            <<d7738>>48205000
   regionbase := tos;                                          <<d7738>>48210000
   end                                                         <<d7738>>48215000
else                                                           <<06212>>48220000
   begin  <<a segment>>                                        <<06212>>48225000
   x:=segdescsysbaseinx;                                       <<06212>>48230000
   tos:=segdescbank;                                           <<06212>>48235000
   tos:=segdescaddr;                                           <<06212>>48240000
   regionbase:=tos;                                            <<06212>>48245000
   end;                                                        <<06212>>48250000
end;  <<subroutine initregionbasevar>>                         <<06212>>48255000
                                                               <<06212>>48260000
                                                               <<06212>>48265000
                                                               <<06212>>48270000
subroutine markobjectimi;                                      <<06212>>48275000
                                                               <<06212>>48280000
<< flags object as on its way in >>                            <<06212>>48285000
                                                               <<06212>>48290000
begin                                                          <<06212>>48295000
                                                               <<06212>>48300000
if mappeddomain then                                           <<06212>>48305000
   begin  <<a mapped domain>>                                  <<06212>>48310000
   tos := mapd'abs'ofst;                                       <<d7738>>48315000
   tos := tos + cdt'md'flags;                                  <<d7738>>48320000
   asmb(lsea);     << load flags word of mapped domain >>      <<d7738>>48325000
   tos.(cdt'imi'bit:1) := 1;  << turn on imi bit >>            <<d7738>>48330000
   if <> then suddendeath(sfkerncachesyncbad);                 <<d7738>>48335000
   tos := mapd'flags := tos;  << save flags value >>           <<d7738>>48340000
   asmb(ssea;ddel);  << store new flags in cdt >>              <<d7738>>48345000
   end                                                         <<06212>>48350000
else                                                           <<06212>>48355000
   begin  <<a seg>>                                            <<06212>>48360000
   x:=segdescsysbaseinx;                                       <<06212>>48365000
   segdescflags.imiflag:=1;                                    <<06212>>48370000
   end;                                                        <<06212>>48375000
                                                               <<06212>>48380000
end;  <<subroutine markobjectimi>>                             <<06212>>48385000
                                                               <<06212>>48390000
                                                               <<06212>>48395000
subroutine getinobjectsqueue;                                  <<06212>>48400000
                                                                        48405000
comment                                                                 48410000
get in seg's queue inserts the process' or devices' identifier          48415000
into the segment's queue.                                               48420000
;                                                                       48425000
begin                                                                   48430000
                                                                        48435000
<<                                                                      48440000
queue proc/device for segment                                           48445000
>>                                                                      48450000
                                                                        48455000
                                                                        48460000
if iosysreq then putdeviceonobjectsmpq(requestorid,            <<06212>>48465000
regionbase) else                                                        48470000
   begin                                                                48475000
   tos := requestorid/pcbsize; << pin >>                       <<06650>>48480000
   tos:=obj;                                                   <<06660>>48485000
   tos:=regionbase;                                                     48490000
   pcbpt := requestorid;                                       <<06650>>48495000
   tos:=sllptr;                                                         48500000
   tos:=specialinfo;  <<reqsllentryinx>>                                48505000
   tos:=false;  <<not prefetch so notify, dec cnt>>            <<06945>>48510000
   putproconobjectsmpq(*,*,*,*,*,*);                           <<06411>>48515000
   end;                                                                 48520000
end <<subroutine getinobjectsqueue>>;                          <<06212>>48525000
                                                               <<06212>>48530000
subroutine startcachemove;                                     <<06212>>48535000
                                                               <<06212>>48540000
begin  <<get the cache move started>>                          <<06212>>48545000
tos:=regionbase;                                               <<06212>>48550000
tos:=tos+rbtosasdisp;                                          <<06212>>48555000
asmb(lsea;stax,ddel);                                          <<06212>>48560000
iostatus:=x.regfetchiostatus;                                  <<06212>>48565000
processcdtlogreqq(cdtentrynumber,iostatus,0);                  <<06212>>48570000
end; <<subroutine startcachemove>>                             <<06212>>48575000
                                                               <<06212>>48580000
                                                               <<06212>>48585000
subroutine handlepresentobject;                                <<06212>>48590000
                                                               <<06212>>48595000
<<checks if object is present, and, if so, sets present,regionb<<06212>>48600000
                                                               <<06212>>48605000
begin                                                          <<06212>>48610000
disable;                                                       <<06212>>48615000
if mappeddomain then                                           <<06212>>48620000
   begin  <<mapped disc domain>>                               <<06212>>48625000
   tos := mapd'abs'ofst;                                       <<d7738>>48630000
   tos := tos + cdt'md'flags;                                  <<d7738>>48635000
   asmb(lsea;delb,delb);                                       <<d7738>>48640000
   tos := mapd'flags := tos;                                   <<d7738>>48645000
   if tos.(cdt'abs'bit:1)=0 then present := true;              <<d7738>>48650000
   end                                                         <<06212>>48655000
else                                                           <<06212>>48660000
   begin  <<a segment>>                                        <<06212>>48665000
   x:=segdescsysbaseinx;                                       <<06212>>48670000
   if not segdescfirminfo.absentflag then present:=true;       <<06212>>48675000
   end;                                                        <<06212>>48680000
if present then                                                <<06212>>48685000
   begin  <<object is present>>                                <<06212>>48690000
   mmstat'(mmstatfetch,objidentifier(objiddescfield),          <<06948>>48695000
          objidentifier(objidnumfield),mstatparm3,mmstatpres,  <<06948>>48700000
          0,0);                                                <<06948>>48705000
   initregionbasevar;                                          <<06212>>48710000
   if mappeddomain and prefetchreq then startcachemove;        <<06411>>48715000
   end;                                                        <<06212>>48720000
if gclassenabledmask.class0 then                               <<06212>>48725000
   begin  <<measure memory allocation event>>                  <<06212>>48730000
   tos:=measstatxdsbank;                                       <<06212>>48735000
   tos:=measstatxdsbase;                                       <<06212>>48740000
   tos:=tos+c0sub0'segreloff+c'memalloc;                       <<06212>>48745000
   asmb(lsea);                                                 <<06212>>48750000
   tos:=tos+1;                                                 <<06212>>48755000
   asmb(ssea;ddel);                                            <<06212>>48760000
   end;                                                        <<06212>>48765000
end;  <<subroutine handlepresentobject>>                       <<06212>>48770000
                                                               <<06212>>48775000
                                                               <<06212>>48780000
subroutine handlerocobject;                                    <<06212>>48785000
                                                               <<06212>>48790000
<<handles objects that are recoverable overlay candidates>>    <<06212>>48795000
                                                               <<06212>>48800000
begin                                                          <<06212>>48805000
if mappeddomain then                                           <<06212>>48810000
   begin  <<mapped disc domain>>                               <<06212>>48815000
   if mapd'flags.(cdt'roc'bit:1) then                          <<d7738>>48820000
      begin                                                    <<06212>>48825000
      roc:=true;                                               <<06212>>48830000
      tos := mapd'abs'ofst;                                    <<d7738>>48835000
      tos := tos + cdt'md'mem'addr;                            <<d7738>>48840000
      asmb(ldea;dxch,ddel);   << put mem addr on tos >>        <<d7738>>48845000
      ocregionbase := tos;                                     <<d7738>>48850000
      end;                                                     <<06212>>48855000
   end                                                         <<06212>>48860000
else                                                           <<06212>>48865000
   begin  <<a segment>>                                        <<06212>>48870000
   x:=segdescsysbaseinx;                                       <<06212>>48875000
   if segdescfirminfo=%100000 then suddendeath(617);           <<06212>>48880000
   if logical(segdescflags).rocflag then roc:= true;           <<06212>>48885000
   end;                                                        <<06212>>48890000
if roc then                                                    <<06212>>48895000
   begin                                                       <<06212>>48900000
   if gclassenabledmask.class0 then                            <<06212>>48905000
      begin  <<measure recover event during allocation>>       <<06212>>48910000
      tos:=measstatxdsbank;                                    <<06212>>48915000
      tos:=measstatxdsbase;                                    <<06212>>48920000
      tos:=tos+c0sub0'segreloff+c'olcandrecovery;              <<06212>>48925000
      asmb(lsea);                                              <<06212>>48930000
      tos:=tos+1;                                              <<06212>>48935000
      asmb(ssea;ddel);                                         <<06212>>48940000
      end;                                                     <<06212>>48945000
   enable;                                                     <<06212>>48950000
   mmstat'(mmstatfetch,objidentifier(objiddescfield),          <<06948>>48955000
          objidentifier(objidnumfield),mstatparm3,mmstatroc,   <<06948>>48960000
          0,0);                                                <<06948>>48965000
   recoveroc(obj,segdescstinx,ocregionbase);                   <<06660>>48970000
   initregionbasevar;                                          <<06212>>48975000
   if mappeddomain and prefetchreq then startcachemove;        <<06411>>48980000
   end;                                                        <<06212>>48985000
end;  <<subroutine handlerocobject>>                           <<06212>>48990000
                                                               <<06212>>48995000
subroutine bumpreadpri;                                        <<02825>>49000000
                                                               <<02825>>49005000
comment                                                        <<02825>>49010000
                                                               <<02825>>49015000
bumps the priority of a pending read request for an object     <<06212>>49020000
already on its way in to at least the priority of the          <<02825>>49025000
requestor.                                                     <<02825>>49030000
                                                               <<02825>>49035000
;                                                              <<02825>>49040000
                                                               <<02825>>49045000
begin                                                          <<02825>>49050000
                                                               <<02825>>49055000
<<determine the state of the read request>>                    <<02825>>49060000
                                                               <<02825>>49065000
disable;                                                       <<02825>>49070000
tos:=regionbase;                                               <<02825>>49075000
tos:=tos+rbtoinitinfodisp;                                     <<02825>>49080000
asmb(lsea);                                                    <<02825>>49085000
drq'entry'index:=reqp:=tos;  <<put read req ptr into index>>   <<06392>>49090000
asmb(ddel);  <<get rid of addr on tos>>                        <<02825>>49095000
tos:=drq'flags;                                                <<06392>>49100000
asmb(tbc completedflag);                                       <<02825>>49105000
if = then                                                      <<02825>>49110000
   begin  <<its not done yet>>                                 <<02825>>49115000
   if drq'preq then                                            <<06627>>49120000
      begin  <<the request is queued>>                         <<02825>>49125000
      if drq'urgclas > logical(procpri) then                   <<06392>>49130000
         begin <<got to bump it>>                              <<02825>>49135000
         drq'urgclas:=procpri;                                 <<06392>>49140000
         discqmanager(reqp,queuereqcode);                      <<06392>>49145000
         if < then suddendeath(618); <<already done>>          <<02825>>49150000
         end;                                                  <<02825>>49155000
      end                                                      <<02825>>49160000
      else if drq'urgclas > logical(procpri)                   <<06392>>49165000
      then drq'urgclas:=procpri;                               <<06392>>49170000
      end;                                                     <<02825>>49175000
asmb(del); <<get rid of flags>>;                               <<02825>>49180000
                                                               <<02825>>49185000
end <<bumpreadpri>> ;                                          <<02825>>49190000
                                                               <<02825>>49195000
                                                               <<06212>>49200000
subroutine handleimiobject;                                    <<06212>>49205000
                                                               <<06212>>49210000
<<handles imi objects>>                                        <<06212>>49215000
                                                               <<06212>>49220000
begin                                                          <<06212>>49225000
if mappeddomain then                                           <<06212>>49230000
   begin  <<mapped disc domain>>                               <<06212>>49235000
   if mapd'flags.(cdt'imi'bit:1)  then imi := true;            <<d7738>>49240000
   end                                                         <<06212>>49245000
else                                                           <<06212>>49250000
   begin  <<a segment>>                                        <<06212>>49255000
   x:=segdescsysbaseinx;                                       <<06212>>49260000
   if segdescfirminfo=%100000 then suddendeath(617);           <<06212>>49265000
   if logical(segdescflags).imiflag                            <<06212>>49270000
   then imi:=true;                                             <<06212>>49275000
   end;                                                        <<06212>>49280000
if imi then                                                    <<06212>>49285000
   begin                                                       <<06212>>49290000
   initregionbasevar;                                          <<06212>>49295000
   specialflags.don'tnotifyflag := 0;                          <<06945>>49300000
   if = then getinobjectsqueue;                                <<06945>>49305000
   if gclassenabledmask.class0 then                            <<06212>>49310000
      begin  <<measure imi event>>                             <<06212>>49315000
      tos:=measstatxdsbank;                                    <<06212>>49320000
      tos:=measstatxdsbase;                                    <<06212>>49325000
      tos:=tos+c0sub0'segreloff+c'inmotionin;                  <<06212>>49330000
      asmb(lsea);                                              <<06212>>49335000
      tos:=tos+1;                                              <<06212>>49340000
      asmb(ssea;ddel);                                         <<06212>>49345000
      end;                                                     <<06212>>49350000
   bumpreadpri;                                                <<06212>>49355000
   mmstat'(mmstatfetch,objidentifier(objiddescfield),          <<06948>>49360000
          objidentifier(objidnumfield),mstatparm3,mmstatimi,   <<06948>>49365000
          0,0);                                                <<06948>>49370000
   end;                                                        <<06212>>49375000
end;  <<subroutine handleimiobject>>                           <<06212>>49380000
                                                               <<06212>>49385000
                                                               <<06212>>49390000
                                                               <<06212>>49395000
<<log fetch event for dump analysis>>                          <<01987>>49400000
                                                               <<01987>>49405000
mstatparm3 := specialflags;                                    <<06948>>49410000
mstatparm3.(1:15) := if specialflags.(0:1) = 1                 <<06948>>49415000
                      then requestorid       << ldev >>        <<06948>>49420000
                    else requestorid/pcbsize;  << pin >>       <<06948>>49425000
                                                                        49430000
<<fill in local variables>>                                    <<06411>>49435000
                                                               <<06411>>49440000
tos:=specialflags;                                                      49445000
if = then asmb(del) else                                                49450000
   begin <<some special aspects to this segment request>>               49455000
   asmb(tbc iosysreqbit);                                               49460000
   if <> then iosysreq:=true;                                           49465000
   asmb(tbc iofzreqbit);                                                49470000
   if <> then iofzreq:=true;                                            49475000
   asmb(tbc bklkreqbit);                                                49480000
   if <> then bklkreq:=true;                                            49485000
   asmb(tbc lkreqbit);                                                  49490000
   if <> then lkreq:=true;                                              49495000
   asmb(tbc fzreqbit);                                                  49500000
   if <> then fzreq:=true;                                              49505000
   asmb(tbc prefetchreqbit);                                   <<06212>>49510000
   if <> then prefetchreq := true;                             <<06212>>49515000
   asmb(del);                                                           49520000
   end;                                                                 49525000
                                                               <<06212>>49530000
pcbpt := requestorid;                                          <<06650>>49535000
if iosysreq then procpri:=forcedwritepri                       <<06411>>49540000
else procpri:=queueinginfo.prifield;                           <<06411>>49545000
                                                                        49550000
                                                               <<06212>>49555000
<<determine object's current state and procede accordingly>>   <<06212>>49560000
                                                               <<06212>>49565000
                                                                        49570000
fetchobject:=mmok;  <<initiatialize return status to success>><<<06212>>49575000
                                                               <<06212>>49580000
if objidentifier(objidtypefield)=objidcdtype then              <<06660>>49585000
   begin <<fetch of a mapped disc domain>>                     <<06212>>49590000
   cdtentrynumber := objidentifier(objidnumfield);             <<06660>>49595000
   if bklkreq or lkreq then suddendeath(sfkernnotsupported);   <<06212>>49600000
   << calculate & save mapped entry's absolute address >>      <<d7738>>49605000
   cdt'abs'on'tos;                                             <<d7738>>49610000
   tos := tos + (cdtentrynumber * cdt'entry'size);             <<d7738>>49615000
   mapd'abs'ofst := tos;                                       <<d7738>>49620000
                                                               <<d7738>>49625000
   mappeddomain := true;                                       <<06212>>49630000
   end                                                         <<06212>>49635000
else                                                           <<06212>>49640000
   begin <<fetching a segment>>                                <<06212>>49645000
   if objidentifier(objidtypefield)=objiddatatype              <<06660>>49650000
   then segdescstinx:=objidentifier(objidnumfield)&lsl(2)      <<06660>>49655000
   else segdescstinx:=convsegidtostinx(obj);                   <<06660>>49660000
   if objidentifier(objidtypefield)=objiddatatype              <<06660>>49665000
   then dataseg' := true;                                      <<06613>>49670000
   x:=segdescsysbaseinx:=dstsysbaseinx+segdescstinx;           <<06212>>49675000
   if bklkreq or lkreq then                                    <<06212>>49680000
   begin  <<get rid of seg if it's not locked>>                         49685000
   if (segdescfirminfo.absentflag land segdescflags.imiflag)            49690000
   lor (segdescfirminfo.absentflag land segdescflags.rocflag)           49695000
   lor not segdescfirminfo.absentflag then                              49700000
      begin  <<seg around or imi-check if locked>>                      49705000
      tos:=segdescbank;                                                 49710000
      tos:=segdescaddr;                                                 49715000
      tos:=tos+rbtorasdisp;                                             49720000
      asmb(lsea);                                                       49725000
       regassignstate:=s0;                                     <<03764>>49730000
                                                               <<06411>>49735000
                                                               <<01897>>49740000
       if not regassignstate.reglkdflag and                    <<03764>>49745000
          not regassignstate.regfzflag then                    <<03764>>49750000
         begin  <<not locked or frozen - get rid of it>>       <<01897>>49755000
         if tos.regiofzflag or segdescflags.imiflag then       <<02300>>49760000
            begin  <<in motion in or iofrzn - wait a while>>   <<01897>>49765000
            fetchobject:=mmsegbusy;                            <<06212>>49770000
            return;                                                     49775000
            end;                                                        49780000
         if not segdescflags.rocflag then                      <<06212>>49785000
            begin <<make into a roc>>                          <<06212>>49790000
            tos:=segdescbank;                                  <<06212>>49795000
            tos:=segdescaddr;                                  <<06212>>49800000
            regionbase:=tos;                                   <<06212>>49805000
            makeoc(segdescstinx,obj,0,regionbase);             <<06660>>49810000
            end;                                               <<06212>>49815000
         disable;                                                       49820000
         segdescflags.rocflag:=0;                                       49825000
         tos:=tos+rastohodadisp;                                        49830000
         asmb(ldea);                                                    49835000
         segdescloda:=tos;  <<put disc address into descriptor>>        49840000
         segdeschoda:=tos;                                              49845000
         tos:=tos+hodatoobjidentdisp;                          <<06212>>49850000
         if objidentifier(objidtypefield)<> objiddatatype      <<06660>>49855000
         or dst(segdescstinx+1).disccopyvalidflag=1 then                49860000
            begin <<wipe out trace of segment in memeory region>>       49865000
            tos:=0d;                                           <<06660>>49870000
            asmb(sdea);                                        <<06660>>49875000
            end                                                         49880000
         else dst(segdescstinx+1).fwipflag:=1;<<signal comp>>  <<01696>>49885000
         asmb(ddel);                                                    49890000
         enable;                                                        49895000
         end                                                   <<01897>>49900000
      else asmb(del);  <<pitch ras>>                           <<01897>>49905000
      end;                                                              49910000
   end;                                                                 49915000
   end;                                                        <<06212>>49920000
                                                               <<06212>>49925000
<<determine object's state and proceed accordingly>>           <<06212>>49930000
                                                               <<06212>>49935000
handlepresentobject;                                           <<06212>>49940000
                                                               <<06212>>49945000
if not present then handlerocobject;                           <<06212>>49950000
                                                               <<06212>>49955000
if not present and not roc then  handleimiobject;              <<06212>>49960000
                                                               <<06212>>49965000
if mappeddomain                                                <<07320>>49970000
and (mapd'flags.(cdt'imo'bit:1))                               <<d7738>>49975000
then returnvalue:=mmsegbusy;                                   <<07320>>49980000
                                                               <<07320>>49985000
if not present and not roc and not imi                         <<07320>>49990000
and returnvalue <> mmsegbusy then                              <<07320>>49995000
   begin <<object must be fetched>>                            <<06212>>50000000
                                                               <<06212>>50005000
                                                               <<07320>>50010000
   <<see if enough disc request entries to complete fetch>>    <<06212>>50015000
                                                               <<06212>>50020000
      if (dqh'tot'ent-dqh'cur'nuse) < 2 then                   <<06392>>50025000
         begin <<not enough disc request entries to procede>>  <<01987>>50030000
         fetchobject:=mmoutofdiscreq;                         <<<06212>>50035000
         return;                                               <<01987>>50040000
         end;                                                  <<01987>>50045000
                                                               <<06212>>50050000
         enable;                                                        50055000
                                                               <<06212>>50060000
    <<must get space and initiate read>>                       <<06212>>50065000
                                                               <<06212>>50070000
         mmstat'(mmstatfetch,objidentifier(objiddescfield),    <<06948>>50075000
                objidentifier(objidnumfield),mstatparm3,       <<06948>>50080000
                mmstatfullfetch,0,0);                          <<06948>>50085000
         if dataseg' then                                      <<06613>>50090000
            begin <<adjust for new size if seg mod pending>>            50095000
            if logical(dst(segdescstinx+1)).segmodreqflag then          50100000
               begin                                                    50105000
               segmodpndg:=true;                                        50110000
               <<find out new size for segment>>                        50115000
               tos := specqhead;                               <<06616>>50120000
               tos := dst(specreqdst&lsl(2) + 2); << bank >>   <<06616>>50125000
               tos := dst(x + 1);                              <<06616>>50130000
               asmb(xchd);                                     <<06616>>50135000
               ddel;                                           <<06616>>50140000
                                                               <<06620>>50145000
               x := tos & lsr(1);     << double index >>       <<06620>>50150000
               while dentryword01 <> obj do                    <<06660>>50155000
                  begin                                        <<06620>>50160000
                  x := x & lsl(1);     << single index >>      <<06620>>50165000
                  x := entryword00;                            <<06620>>50170000
                  x := x & lsr(1);     << double index >>      <<06620>>50175000
                  end;                                         <<06620>>50180000
               x := x & lsl(1);      << single index >>        <<06620>>50185000
               specreqinx:=x;                                           50190000
               tos:=entryword03 & lsl(2);    << new dst size >><<06620>>50195000
               tos := %1000d;                                  <<06616>>50200000
               asmb(xchd);                                     <<06616>>50205000
               ddel;                                           <<06616>>50210000
               end                                                      50215000
            else tos:=dst(segdescstinx).datasizefield&lsl(2);           50220000
            xfercnt:=dst(segdescstinx).datasizefield&lsl(2);            50225000
            end                                                         50230000
         else if mappeddomain then                             <<06212>>50235000
            begin                                              <<06212>>50240000
            tos := mapd'abs'ofst;                              <<d7738>>50245000
                                                               <<d7738>>50250000
            exchdb;   << db is pointing to entry >>            <<d7738>>50255000
            startsector:=cdt'darray(cdt'md'sector&asr(1));     <<d7738>>50260000
            limitsector:=cdt'darray(cdt'md'end'sector&asr(1)); <<d7738>>50265000
            exchdb;   << back to original db >>                <<d7738>>50270000
            asmb(ddel);  << remove abs db >>                   <<d7738>>50275000
            tos:=limitsector-startsector; <<# of sector>>      <<06212>>50280000
            tos := tos*sectorsizeinwords;                      <<06212>>50285000
            xfercnt:=s0;                                       <<06212>>50290000
            end                                                <<06212>>50295000
         else                                                  <<06212>>50300000
            begin <<code seg>>                                 <<06212>>50305000
            x:=segdescsysbaseinx;                                       50310000
            tos:=segdescfirminfo.codesizefield&lsl(2);                  50315000
            xfercnt:=s0;                                                50320000
            end;                                                        50325000
         objsize:=s0;                                          <<06212>>50330000
         if = then suddendeath(619);                           <<01644>>50335000
         tos:=(tos+overhead-1)&lsr(pagepower)+1;                        50340000
         reqsize:=tos;                                                  50345000
         if lkreq or bklkreq then                                       50350000
            begin                                                       50355000
            if awaketoschedmsg < curractpri then               <<d7738>>50360000
               begin                                           <<d7738>>50365000
               returnvalue := mmpreempt;                       <<d7738>>50370000
               return;                                         <<d7738>>50375000
               end;                                            <<d7738>>50380000
                                                               <<d7738>>50385000
            regionbase:=createlockspace(reqsize);                       50390000
            if <> then                                                  50395000
               begin  <<didn't make it>>                                50400000
               if < then fetchobject:=mmsegbusy               <<<06212>>50405000
               else fetchobject:=mmnolockspace;               <<<06212>>50410000
               return;                                                  50415000
               end;                                                     50420000
            end;                                                        50425000
         if reqsize > logical(maxavailreg) then                         50430000
            begin <<not a big enough region available>>                 50435000
            tos:=makeroom(requestorid,reqsize,hardrequest);             50440000
            fetchobject:=s0;                                  <<<06212>>50445000
            if tos <> mmok then return;                        <<01987>>50450000
               if gclassenabledmask.class0 then                <<ray.v>>50455000
                  begin <<count successful makeroom>>          <<ray.v>>50460000
                  tos:=measstatxdsbank;                        <<ray.v>>50465000
                  tos:=measstatxdsbase;                        <<ray.v>>50470000
                  tos:=tos+c0sub0'segreloff+c'makeroomsuccess; <<ray.v>>50475000
                  asmb(lsea;inca;ssea;ddel);                   <<ray.v>>50480000
                  end;                                         <<ray.v>>50485000
               end                                             <<ray.v>>50490000
            else                                               <<ray.v>>50495000
               if gclassenabledmask.class0 then                <<ray.v>>50500000
                  begin <<count found free space>>             <<ray.v>>50505000
                  tos:=measstatxdsbank;                        <<ray.v>>50510000
                  tos:=measstatxdsbase;                        <<ray.v>>50515000
                  tos:=tos+c0sub0'segreloff+c'freespace;       <<ray.v>>50520000
                  asmb(lsea);                                  <<ray.v>>50525000
                  tos:=tos+1;                                  <<ray.v>>50530000
                  asmb(ssea;ddel);                             <<ray.v>>50535000
                  end;                                         <<ray.v>>50540000
         <<                                                             50545000
         space is available for request-reserve a region                50550000
                   and initiate the segment read                        50555000
         >>                                                             50560000
                                                                        50565000
         if lkreq or bklkreq                                            50570000
         then tos:=reserveregion(reqsize,maxholesize,procpri,           50575000
            lockcode,regionbase)                                        50580000
         else tos:=reserveregion(reqsize,maxholesize,procpri,           50585000
            noinfo,0d);                                                 50590000
                                                               <<06212>>50595000
         asmb(dtst);  << make sure region addr is non-zero >>  <<*7564>>50600000
         regionbase:=tos;                                               50605000
         if = then suddendeath(619);                           <<01644>>50610000
                                                               <<06212>>50615000
         <<get disc addr of object, put object's mem addr>>    <<06212>>50620000
                                                               <<06212>>50625000
         getda'putrb;                                          <<06212>>50630000
         <<check for stack expansions requiring a displaced read>>      50635000
                                                                        50640000
         if dataseg' then                                      <<06613>>50645000
            begin                                                       50650000
            if logical(dst(x:=objidentifier(objidnumfield)     <<06660>>50655000
                                           &lsl(2)+1)).stkflag <<06660>>50660000
            then                                               <<06212>>50665000
               begin                                                    50670000
               if logical(dst(x)).segmodreqflag then                    50675000
                  begin <<look up read offset>>                         50680000
                  tos := specreqinx;                           <<06616>>50685000
                  tos := dst(specreqdst&lsl(2) + 2); << bank >><<06616>>50690000
                  tos := dst(x + 1);                           <<06616>>50695000
                  asmb(xchd);                                  <<06616>>50700000
                  ddel;                                        <<06616>>50705000
                  x := tos;                                    <<06616>>50710000
                  readoffset:=entryword04;                     <<06620>>50715000
                  tos := %1000d;                               <<06616>>50720000
                  asmb(xchd);                                  <<06616>>50725000
                  ddel;                                        <<06616>>50730000
                  end;                                                  50735000
               end;                                                     50740000
            end;                                                        50745000
                                                                        50750000
                                                               <<06212>>50755000
         << build object read disc request                     <<06212>>50760000
                                                               <<06212>>50765000
                                                                        50770000
         if mappeddomain then                                  <<06411>>50775000
           begin                                               <<06411>>50780000
           tos := mapd'abs'ofst;                               <<d7738>>50785000
           tos := tos + cdt'md'discreq;                        <<d7738>>50790000
           asmb(lsea;delb;delb);  << load disc req >>          <<d7738>>50795000
           if = then suddendeath(sfkerncacheintbad);           <<d7738>>50800000
         x := discreqinx := tos;                               <<06948>>50805000
           end                                                 <<06411>>50810000
                                                               <<06411>>50815000
         else x:=discreqinx:=getdiscreq(2); <<no impede>>      <<06392>>50820000
         if x=0 then suddendeath(601); <<discreqtab too small>><<01644>>50825000
         drq'entry'index:=x;                                   <<06392>>50830000
         drq'flags:=0;                                         <<06392>>50835000
         drq'mmreq:=1;                                         <<06392>>50840000
         tos:=regionbase;                                               50845000
         tos:=readoffset;                                               50850000
         asmb(dup);                                                     50855000
         drq'segdisp:=tos;                                     <<06392>>50860000
         asmb(ladd);                                                    50865000
         drq'bufadr:=tos;                                      <<06392>>50870000
         drq'bufdst:=tos;                                      <<06392>>50875000
         drq'func:=readreq;                                    <<06392>>50880000
         tos:=xfercnt;                                                  50885000
         drq'count:=tos;                                       <<06392>>50890000
         drq'ldev:=hoda.(0:8);                                 <<06392>>50895000
         drq'parm1:=hoda.(8:8);                                <<06392>>50900000
         drq'stat:=0;                                          <<06392>>50905000
                                                               <<08803>>50910000
         drq'pcb := 0;  <<necessary for siodm function>>       <<08803>>50915000
                                                               <<08803>>50920000
         drq'qmisc := 0;                                       <<07320>>50925000
         drq'parm2:=loda;                                      <<06392>>50930000
         drq'segid1 := objidentifier(objiddescfield);          <<06941>>50935000
         drq'segid2 := objidentifier(objidnumfield);           <<06941>>50940000
         if swappingin then drq'urgclas:=bkgrndreadpri         <<06392>>50945000
         else drq'urgclas:=procpri;                            <<06392>>50950000
                                                               <<06212>>50955000
    <<if swappingin then auxdiscreqflags.swapinreadreqflag:=1>><<06212>>50960000
                                                                        50965000
                                                               <<06212>>50970000
         << put objident, discreqp, disc address into header>> <<06212>>50975000
                                                               <<06212>>50980000
                                                                        50985000
         tos:=regionbase;                                               50990000
         tos:=tos+rbtoobjidentdisp;                            <<06212>>50995000
         tos:=obj;                                             <<06660>>51000000
         asmb(sdea);                                           <<06660>>51005000
         tos:=tos+objidenttoinitinfodisp;                      <<06212>>51010000
         tos:=drq'entry'index;                                 <<06392>>51015000
         asmb(ssea);  <<put discreqp into the region header>>           51020000
         tos:=tos+initinfotohodadisp;                                   51025000
         tos:=hoda;                                                     51030000
         tos:=loda;                                                     51035000
         asmb(sdea);                                                    51040000
                                                                        51045000
         <<                                                             51050000
         build request completion message, and store into header        51055000
         >>                                                             51060000
                                                                        51065000
         tos:=tos+hodatocompmsgdisp;                                    51070000
         tos:=0;                                                        51075000
         if segmodpndg then tos.compmsgmodflag:=1;                      51080000
         if bklkreq then tos.compmsgblkdlkflag:=1;                      51085000
         asmb(ssea);                                                    51090000
                                                                        51095000
                                                               <<06212>>51100000
         <<get process/device in line for the segment>>        <<06212>>51105000
                                                               <<06212>>51110000
                                                                        51115000
         disable;                                              <<07320>>51120000
                                                               <<06212>>51125000
         specialflags.don'tnotifyflag := 0;                    <<06945>>51130000
         if = then                                             <<06945>>51135000
            getinobjectsqueue;                                 <<06945>>51140000
                                                                        51145000
         <<mark object in motion in>>                          <<06212>>51150000
                                                               <<06212>>51155000
         markobjectimi;                                        <<06212>>51160000
                                                               <<06212>>51165000
         <<if a mapped disc domain, get region linked into>>   <<06212>>51170000
         <<list of cached disc domains>>                       <<06212>>51175000
                                                               <<06212>>51180000
         if mappeddomain then                                  <<06212>>51185000
            begin <<set cached region flag, link>>             <<06212>>51190000
            tos:=regionbase;;                                  <<06212>>51195000
            tos:=tos + rbtosasdisp;                            <<06212>>51200000
            asmb(lsea);                                        <<06212>>51205000
            tos.regcachedflag:=1;                              <<06212>>51210000
            tos.regfetchiostatus:=iostatusok;<<for virgins>>   <<06212>>51215000
            asmb(ssea;ddel);                                   <<06212>>51220000
             << pass subregion size to link procedure >>       <<06411>>51225000
             tos := regionbase;                                <<06411>>51230000
             tos := tos + rbtossdisp;                          <<06411>>51235000
             asmb(lsea;stax);  << save old ss in x-register>>  <<06411>>51240000
             tos := reqsize;   << region pages >>              <<06411>>51245000
             asmb(ssea);                                       <<06411>>51250000
             enable;                                           <<*7564>>51255000
             linkcachedregion(regionbase);                     <<06411>>51260000
             disable;                                          <<*7564>>51265000
             asmb(ldxa;ssea;ddel); << restore ss from x-reg>>  <<*7564>>51270000
            tos := mapd'abs'ofst;                              <<d7738>>51275000
            tos := tos + cdt'md'flags;                         <<d7738>>51280000
            asmb(lsea;delb,delb);  << load flags word on tos >><<d7738>>51285000
            mapd'flags := tos;     << save flags for later   >><<d7738>>51290000
            end;                                               <<06212>>51295000
                                                                        51300000
         <<                                                             51305000
         build initiation message and put in region header              51310000
         >>                                                             51315000
                                                                        51320000
         tos:=tos+compmsgtoinitmsgdisp;                                 51325000
         disable;                                                       51330000
         asmb(lsea);                                                    51335000
         if mappeddomain                                       <<06212>>51340000
         and (mapd'flags.(cdt'virgin'bit:1))                   <<d7738>>51345000
         then tos.initmsgstartcompflag := 1                    <<06212>>51350000
         else tos.queuereadreqflag:=1;                         <<06212>>51355000
         tos.initmsgtoggleswitch:=0;                                    51360000
         if mappeddomain                                       <<06212>>51365000
            and (mapd'flags.(cdt'imo'bit:1))                   <<d7738>>51370000
         then tos.msgextdisabledflag:=1;                       <<06411>>51375000
         if dataseg' and not logical(dst(x:=segdescstinx+1)).  <<06613>>51380000
            disccopyvalidflag then tos.msgextdisabledflag:=1;           51385000
         asmb(ssea);                                                    51390000
         tos:=tos+initmsgtorbdisp;                                      51395000
         processinitmsg(*);                                             51400000
   end;                                                                 51405000
                                                               <<06212>>51410000
if dataseg' and specialflags.setmapreqflag then                <<*7766>>51415000
   begin                                                       <<*7766>>51420000
   tos := regionbase;                                          <<*7766>>51425000
   tos := tos + rbtorasdisp;                                   <<*7766>>51430000
   asmb (lsea);                                                <<*7766>>51435000
   ls0.regmapflag := 1;                                        <<*7766>>51440000
   asmb (ssea;ddel);                                           <<*7766>>51445000
   end;                                                        <<*7766>>51450000
                                                               <<*7766>>51455000
<<perform any special processing>>                             <<06212>>51460000
                                                               <<06212>>51465000
tos:=specialflags;                                                      51470000
if <> and returnvalue = mmok then                              <<07320>>51475000
   begin <<update special state counters in the region header>>         51480000
   disable;                                                             51485000
   tos:=regionbase;                                                     51490000
                                                               <<06212>>51495000
   if iofzreq then                                                      51500000
      begin                                                             51505000
      if a'disc then                                           <<*7606>>51510000
         begin    << it's a disc request index >>              <<*7606>>51515000
         drq'entry'index := requestorid.(2:14);                <<*7606>>51520000
         if drq'datafrzn or drq'done then return;              <<*7606>>51525000
         drq'datafrzn := 1;                                    <<*7606>>51530000
         end;                                                  <<*7606>>51535000
                                                               <<*7606>>51540000
      tos:=tos+rbtowdiofzcntdisp;                                       51545000
      asmb(lsea);                                                       51550000
      count:=tos;                                                       51555000
      count.iofzcntfield:=count.iofzcntfield+1;                         51560000
      tos:=count;                                                       51565000
      asmb(ssea);                                                       51570000
      tos:=tos+wdiofzcnttorasdisp;                                      51575000
      asmb(lsea);                                                       51580000
      tos.regiofzflag:=1;                                               51585000
      asmb(ssea);                                                       51590000
      mmstat'(mmstatspecreq,objidentifier(objiddescfield),     <<06948>>51595000
             objidentifier(objidnumfield),%100000,             <<06948>>51600000
             count.iofzcntfield,0,0);                          <<06948>>51605000
      end                                                               51610000
   else                                                                 51615000
      begin                                                             51620000
      tos:=tos+rbtolkfzcntdisp;                                         51625000
      asmb(lsea);                                                       51630000
      count:=tos;                                                       51635000
      if lkreq or bklkreq then count.lkcntfield:=count.lkcntfield+1     51640000
      else if fzreq then count.fzcntfield:=count.fzcntfield+1;          51645000
      tos:=count;                                                       51650000
      asmb(ssea);                                                       51655000
      tos:=tos+lkfzcnttorasdisp;                                        51660000
      asmb(lsea);                                                       51665000
      if fzreq then tos.regfzflag:=1                                    51670000
      else if lkreq or bklkreq then tos.reglkdflag:=1;                  51675000
      asmb(ssea);                                                       51680000
      if lkreq or bklkreq then                                 <<01571>>51685000
         mmstat'(mmstatspecreq,objidentifier(objiddescfield),  <<06948>>51690000
               objidentifier(objidnumfield),%100002,count,0,0) <<06948>>51695000
      else if fzreq then                                       <<01571>>51700000
         mmstat'(mmstatspecreq,objidentifier(objiddescfield),  <<06948>>51705000
               objidentifier(objidnumfield),%100001,count,0,0);<<06948>>51710000
      sllinx := specialinfo;                                   <<06625>>51715000
      if fzreq then sll(sll'flags).sllfzreqflag := 0           <<06625>>51720000
      else if lkreq then sll(sll'flags).slllkreqflag := 0      <<06625>>51725000
      else if bklkreq then sll(sll'flags).sllblklockreqflag:=0;<<06625>>51730000
      if gclassenabledmask.class0 then                                  51735000
         begin  <<measure lock or freeze request>>                      51740000
         tos:=measstatxdsbank;                                          51745000
         tos:=measstatxdsbase;                                          51750000
         if fzreq then tos:=tos+c0sub0'segreloff+c'freezereq   <<ray.v>>51755000
            else tos:=tos+c0sub0'segreloff+c'lockreq;          <<ray.v>>51760000
         asmb(lsea);                                                    51765000
         if fzreq and count.fzcntfield=1 then tos:=tos+1                51770000
         else if count.lkcntfield=1 then tos:=tos+1;                    51775000
         asmb(ssea;ddel);                                               51780000
         end;                                                           51785000
      end;                                                              51790000
   end;                                                                 51795000
end   <<procedure fetchobject>>;                               <<06212>>51800000
                                                                        51805000
$page "MEMORY ALLOCATION PROCEDURES : SWAPIN"                           51810000
                                                               <<06411>>51815000
integer procedure swapin(swapinprocinx,swapinstructions);      <<06411>>51820000
value swapinprocinx,swapinstructions;                          <<06411>>51825000
integer swapinprocinx;                                         <<06411>>51830000
logical swapinstructions;                                      <<06411>>51835000
option privileged,uncallable;                                           51840000
                                                                        51845000
comment                                                                 51850000
                                                                        51855000
swapin is invoked by a cpu's dispatcher when he has decided to          51860000
devote his cpu to working on swapping in the locality of                51865000
a process requiring scheduling attention.                      <<06212>>51870000
                                                                        51875000
swapin monitors the awaketoschedmsg and the curractpri to               51880000
see if something more urgent is pending, and if so returns to           51885000
the dispatcher (partial swapins are ok).                                51890000
                                                                        51895000
the locality list of swapinprocinx is checked to find the next          51900000
segment request of the process.  if the segment is not already          51905000
allocated to the process, fetchobject is invoked to fetch      <<06212>>51910000
the segment for this process.                                           51915000
                                                               <<06411>>51920000
the swapinstructions parameter indicate any special servicing  <<06411>>51925000
required for this swap request.  these special instructioons   <<06411>>51930000
include a hard swap required (ie overrule the thrash control   <<06411>>51935000
mechanism and get this guy in no matter what), and a wake up   <<06411>>51940000
control that causes the process to be awakened or not to be    <<06411>>51945000
awakened when its swap completes (don't wake up if swapin is   <<06411>>51950000
being called directly from the process' stack on a prefetch    <<06411>>51955000
request).                                                      <<06411>>51960000
                                                               <<06411>>51965000
                                                                        51970000
swapin returns status from fetchsegment or according to the    <<06411>>51975000
defined constants for memory management status                 <<06411>>51980000
                                                               <<06411>>51985000
                                                               <<06411>>51990000
                                                               <<06411>>51995000
;                                                                       52000000
                                                                        52005000
begin                                                                   52010000
                                                                        52015000
logical returnvalue=swapin;                                             52020000
                                                               <<06625>>52025000
integer                                                        <<06660>>52030000
        sllheadinx, << index to sll header entry >>            <<06625>>52035000
        pcbpt,                                                 <<06650>>52040000
        nextreqinx,                                                     52045000
        mstatparm2,                                            <<01571>>52050000
        sllinx;     << index to sll regular entry >>           <<06625>>52055000
                                                               <<06625>>52060000
double objidentifier;                                          <<06660>>52065000
double savetime;                                                        52070000
                                                               <<06625>>52075000
                                                               <<06625>>52080000
logical specialreqflags,                                                52085000
        hardrequest:=false,                                    <<06945>>52090000
        gotsomememory:=false,                                           52095000
        swaprequired:=false;                                            52100000
                                                                        52105000
                                                                        52110000
swapin:=mmok; <<assume success>>                               <<01987>>52115000
                                                                        52120000
<<                                                                      52125000
start reserving space for the process' locality                         52130000
>>                                                                      52135000
                                                                        52140000
if gclassenabledmask.class0 then savetime:=timer;                       52145000
pcbpt := swapinprocinx;                                        <<06650>>52150000
sllheadinx := sllptr;                                          <<06625>>52155000
if swapinstructions.swaphardrequest then hardrequest:=true;    <<06411>>52160000
disable;                                                                52165000
                                                               <<04484>>52170000
startscanover:                                                 <<04484>>52175000
                                                                        52180000
if sll(schedtoiomsg).sllswapreqflag then swaprequired := true; <<06625>>52185000
if (not sll(schedtoiomsg).sllswapipflag land swaprequired)     <<06625>>52190000
   lor sll(schedtoiomsg).sllstartoverflag                      <<06625>>52195000
   lor (integer(sll(segcount)) > sllobjlimit) then             <<06625>>52200000
   begin  <<chop to min locality and start swap over>>         <<01913>>52205000
   tos:=swapinprocinx;                                                  52210000
   asmb(dzro,dzro);                                            <<06660>>52215000
   tos.initlocflag:=1;                                                  52220000
   adjustlocality(*,*,*,*);                                             52225000
   swaprequired := true;                                       <<*7564>>52230000
   sll(memreqinx) := sll(firstinx);                            <<06625>>52235000
   sll(schedtoiomsg).sllstartoverflag := 0;                    <<06625>>52240000
   end;                                                                 52245000
                                                               <<06625>>52250000
sll(schedtoiomsg).sllswapipflag := 1;                          <<06625>>52255000
sllinx := sll(memreqinx);                                      <<06625>>52260000
                                                               <<06625>>52265000
while sllinx <> 0 do                                           <<06625>>52270000
   begin                                                                52275000
   tos := sll(sll'objdesc);                                    <<06660>>52280000
   tos := sll(sll'objnum);                                     <<06660>>52285000
   objidentifier := tos;                                       <<06660>>52290000
   specialreqflags:=0;                                                  52295000
   tos := sll(sll'flags);                                      <<06625>>52300000
   asmb(tbc sllfzreqbit);                                               52305000
   if <> then specialreqflags.fzreqflag:=1;                             52310000
   asmb(tbc slllkreqbit);                                               52315000
   if <> then specialreqflags.lkreqflag:=1;                             52320000
   asmb(tbc sllblklockreqbit);                                          52325000
   if <> then specialreqflags.bklkreqflag:=1;                           52330000
   if s0.sllprefetchcount <> 0 then                            <<06945>>52335000
      begin                                                    <<06945>>52340000
      specialreqflags.prefetchreqflag := 1;                    <<06945>>52345000
      if s0.slldeccntflag = 0                                  <<06945>>52350000
      then specialreqflags.don'tnotifyflag :=1;                <<06945>>52355000
      end;                                                     <<06945>>52360000
   << if called from prefetchobject (i.e. on a user's stack) >><<07320>>52365000
   << then don't want to be queued for any object fetch.     >><<07320>>52370000
                                                               <<07320>>52375000
   if curprc <> 0 then specialreqflags.don'tnotifyflag := 1;   <<07320>>52380000
                                                               <<07320>>52385000
   asmb(del);                                                  <<06945>>52390000
                                                               <<*7564>>52395000
   if sll(sll'flags).sllmapsegflag then                        <<*7766>>52400000
      specialreqflags.setmapreqflag := 1;                      <<*7766>>52405000
                                                               <<*7766>>52410000
   << save next sll entry. done before fetchobject in case  >> <<*7564>>52415000
   << an sll entry gets removed on us.                      >> <<*7564>>52420000
                                                               <<*7564>>52425000
   nextreqinx := sll(nextinx);                                 <<*7564>>52430000
                                                               <<*7564>>52435000
   enable;                                                              52440000
   if sll(sll'flags).sllimiflag then swapin := mmok            <<*7564>>52445000
   else swapin := fetchobject(objidentifier,swapinprocinx,     <<06212>>52450000
      specialreqflags,sllinx,hardrequest);                     <<06625>>52455000
   disable;                                                             52460000
                                                               <<06212>>52465000
   if returnvalue <> mmok then                                 <<06212>>52470000
      begin  <<fetch couldn't complete>>                                52475000
      nextreqinx:=0;                                                    52480000
      if returnvalue  = mmnolockspace <<no lock space>>        <<06212>>52485000
      then sll(sll'flags).slltossentryflag := 1;               <<06625>>52490000
      end                                                               52495000
   else                                                                 52500000
      begin  <<seg allocated successfully>>                             52505000
      gotsomememory:=true;                                              52510000
      if sll(schedtoiomsg).sllstartoverflag then               <<06625>>52515000
         go startscanover;                                     <<04484>>52520000
      if not swaprequired then                                          52525000
         begin <<all done with this guy>>                               52530000
         sll(memreqinx) := nextreqinx := 0;                    <<06625>>52535000
         end                                                            52540000
      else                                                              52545000
         begin  <<put next request into memreqinx>>                     52550000
         sll(memreqinx) := nextreqinx;                         <<06625>>52555000
         end;                                                           52560000
      end;                                                              52565000
   sllinx := nextreqinx;                                       <<06625>>52570000
   end;                                                                 52575000
if gotsomememory then sll(schedtoiomsg).sllhasmemflag := 1;    <<06625>>52580000
if returnvalue = mmok then                                     <<06212>>52585000
   begin <<swap complete>>                                              52590000
   tos := sll(schedtoiomsg);                                   <<06625>>52595000
   tos.sllswapreqflag:=0;                                               52600000
   tos.sllswapipflag:=0;                                                52605000
   sll(schedtoiomsg) := s0;                                    <<06625>>52610000
   resabortinfo.sarflag := 0;                                  <<06650>>52615000
   resabortinfo.pcbshortwaitflag := 1;                         <<06650>>52620000
   if tos.slliocomptoawakemsg=0                                <<06411>>52625000
   and swapinstructions.swapwakeup then                        <<06411>>52630000
      begin <<process is ready to be launched>>                         52635000
      swapin:=mmpreempt;<<signal disp to start over>>          <<06411>>52640000
      awake(swapinprocinx,memorywaitcode,nowait);              <<06650>>52645000
      enable;                                                  <<*8461>>52650000
      end;                                                              52655000
   end;                                                                 52660000
mstatparm2 := %100000;                                         <<01571>>52665000
mstatparm2.(1:1) := if swaprequired then 1 else 0;             <<01571>>52670000
mstatparm2.(12:4):= returnvalue;                               <<01571>>52675000
mmstat'(mmstatswapin,swapinprocinx/pcbsize,mstatparm2,         <<06948>>52680000
        hardrequest,0,0,0);                                    <<06948>>52685000
if gclassenabledmask.class0 then                                        52690000
   begin  <<measure swap-in event and duration>>                        52695000
   tos:=measstatxdsbank;                                                52700000
   tos:=measstatxdsbase;                                                52705000
   tos:=tos+c0sub0'segreloff+c'swapin;                         <<ray.v>>52710000
   asmb(lsea);                                                          52715000
   tos:=tos+1;                                                          52720000
   asmb(ssea);                                                          52725000
   tos:=tos-c'swapin+c'cpumemoryalloc;                         <<ray.v>>52730000
   asmb(ldea);                                                          52735000
   tos:=timer-savetime;                                                 52740000
   asmb(dadd;sdea;ddel);                                                52745000
   end;                                                                 52750000
if gclassenabledmask.class15 then                              <<01812>>52755000
   begin <<prcoess level swapin>>                              <<01812>>52760000
   tos:=measprocxdsbank;                                       <<01812>>52765000
   tos:=measprocxdsbase;                                       <<01812>>52770000
   tos:=tos+ics(-ics'candpincell)*                             <<01812>>52775000
        class15'sub0size+cp'swapin;                            <<01812>>52780000
   asmb(lsea);                                                 <<01812>>52785000
   tos:=tos+1;                                                 <<01812>>52790000
   asmb(ssea;ddel);                                            <<01812>>52795000
   end;                                                        <<01812>>52800000
end  <<swapin>>;                                                        52805000
                                                                        52810000
$page "GARBAGE COLLECTION"                                              52815000
                                                                        52820000
procedure collectgarbage(singleholebase);                               52825000
value singleholebase;                                                   52830000
double singleholebase;                                                  52835000
option privileged,uncallable;                                           52840000
                                                                        52845000
comment                                                                 52850000
                                                                        52855000
collectgarbage combines holes during otherwise idle periods.            52860000
since garbage collection is a background activity, the                  52865000
awaketoschedmsg is sampled at convenient times so that more             52870000
urgent pending activity can be responded to.                            52875000
                                                                        52880000
the selected strategy proceeds from the largest to the smallest         52885000
hole. it is first attempted to combine the hole with the previous       52890000
hole in the bank, then with the following hole in the bank.             52895000
the combinations are performed by moving all segments between           52900000
the lower and upper hole to the base of some other small hole.          52905000
the combinations will be performed if :                                 52910000
                                                                        52915000
   (i). the move of the intermediate segments does not exceed the       52920000
        configured move threshold,                                      52925000
                                                                        52930000
  (ii). no intervening segments are locked, frozen, or i/o frozen,      52935000
                                                                        52940000
 (iii). a small destination hole which is clean of ongoing internal     52945000
        i/o can be obtained.                                            52950000
                                                                        52955000
;                                                                       52960000
                                                                        52965000
begin                                                                   52970000
                                                                        52975000
integer movepagecnt:=0;                                                 52980000
                                                                        52985000
                                                                        52990000
double nextcandbase:=0d,                                                52995000
       currentholebase:=0d,                                             53000000
       firstmemoryaddress,                                              53005000
       currentflipbase,                                                 53010000
       upperboundbase,                                                  53015000
       nextflipbase,                                                    53020000
       lowerboundbase,                                                  53025000
       lowerholebase,                                                   53030000
       upperholebase,                                                   53035000
       destholebase,                                                    53040000
       movesource,                                                      53045000
       savetime,                                                        53050000
       combinedholebase;                                                53055000
                                                                        53060000
                                                                        53065000
integer currentholesize:=maxholesize,                                   53070000
        thisregionsize,                                                 53075000
        segdescsysbaseinx,                                              53080000
        segdescstinx,                                                   53085000
        lowerholesize,                                                  53090000
        upperholesize,                                                  53095000
        combinedholesize;                                               53100000
                                                                        53105000
logical gotone,                                                         53110000
        can'tmove,                                                      53115000
        startover,                                                      53120000
        combinebelow,                                                   53125000
        combineabove,                                                   53130000
        moved,                                                          53135000
        getready,                                                       53140000
        ready,                                                          53145000
        goonce,                                                         53150000
        gotnexthole,                                                    53155000
        giveup;                                                         53160000
double  obj;                                                   <<06660>>53165000
logical array objid(*)=obj;                                    <<06660>>53170000
                                                                        53175000
subroutine selectnextcand;                                              53180000
                                                                        53185000
comment                                                                 53190000
                                                                        53195000
selects the available region about which garbage collection wil<<06945>>53200000
take place.  collection proceeds from the largest hole         <<06945>>53205000
backwards through the available region list.                   <<06945>>53210000
                                                                        53215000
;                                                                       53220000
                                                                        53225000
begin                                                                   53230000
if startover then                                              <<06945>>53235000
   currentholesize := maxholesize;                             <<06945>>53240000
<< select current hole base >>                                 <<06945>>53245000
if singleholebase <> 0d then                                            53250000
   begin <<just a single shot>>                                         53255000
   if currentholebase <> 0d then currentholebase:=0d <<done>>           53260000
   else currentholebase:=singleholebase;                                53265000
   end                                                                  53270000
else if nextcandbase <> 0d and not startover then              <<06945>>53275000
   currentholebase := nextcandbase                             <<06945>>53280000
else if startover then                                         <<06945>>53285000
   begin                                                       <<06945>>53290000
   tos := holelisttail;                                        <<06945>>53295000
   if <> then tos := tos + nltorbdisp;                         <<07320>>53300000
   currentholebase := tos;                                     <<06945>>53305000
   end                                                         <<06945>>53310000
else currentholebase := nextcandbase;                          <<06945>>53315000
                                                               <<06945>>53320000
<< select next candidate base >>                               <<06945>>53325000
                                                               <<06945>>53330000
if singleholebase <> 0d then nextcandbase:=0d else                      53335000
   begin <<not just a single shot>>                                     53340000
   tos:=currentholebase;                                                53345000
   if = then nextcandbase:=tos else                                     53350000
      begin                                                             53355000
      tos := tos+rbtopldisp;    << prev in list >>             <<06945>>53360000
      asmb(ldea);                                                       53365000
      if = then nextcandbase := tos else                       <<06945>>53370000
         begin                                                 <<06945>>53375000
         tos := tos + pltorbdisp;                              <<06945>>53380000
         nextcandbase := tos;                                  <<06945>>53385000
         end;                                                  <<06945>>53390000
      asmb(ddel);                                                       53395000
      end;                                                              53400000
   end;                                                                 53405000
                                                               <<06945>>53410000
<< determine current hole size >>                              <<06945>>53415000
                                                               <<06945>>53420000
tos:=currentholebase;                                                   53425000
if = then                                                               53430000
   begin <<should quit>>                                                53435000
   asmb(ddel);                                                          53440000
   currentholesize:=0;                                                  53445000
   end                                                                  53450000
else                                                                    53455000
   begin                                                                53460000
   tos:=tos+rbtorsdisp;                                                 53465000
   asmb(lsea);                                                          53470000
   currentholesize:=tos;                                                53475000
   asmb(ddel);                                                          53480000
   end;                                                                 53485000
startover:=false;                                                       53490000
                                                               <<06945>>53495000
<< skip over holes that are already of max size. >>            <<06945>>53500000
                                                               <<06945>>53505000
if currentholesize=maxholesize then selectnextcand; <<recursive>>       53510000
end <<subroutine selectnextcand>>;                                      53515000
                                                               <<06212>>53520000
                                                               <<06212>>53525000
subroutine markobjectabsent;                                   <<06212>>53530000
                                                               <<06212>>53535000
<<sets the absent bit of the object identiifed by objid>>      <<06212>>53540000
                                                               <<06212>>53545000
begin                                                          <<06212>>53550000
if objid(objidtypefield)=objidcdtype then                      <<06660>>53555000
   begin  <<a mapped domain>>                                  <<06212>>53560000
   if objid(objidnumfield)<> 0 then                            <<06660>>53565000
      begin  <<cached domain has a cdt entry>>                 <<06212>>53570000
      cdt'abs'on'tos;                                          <<d7738>>53575000
      tos := tos + cdt'md'flags +                              <<d7738>>53580000
             (objid(objidnumfield) * cdt'entry'size);          <<d7738>>53585000
      asmb(lsea);                                              <<d7738>>53590000
      tos.(cdt'abs'bit:1) := 1;                                <<d7738>>53595000
      if <> then suddendeath(sfkerncachesyncbad);              <<d7738>>53600000
      asmb(ssea;ddel);                                         <<d7738>>53605000
      end;                                                     <<d7738>>53610000
   end                                                         <<06212>>53615000
else                                                           <<06212>>53620000
   begin  <<a seg>>                                            <<06212>>53625000
   if objid(objidtypefield)=objiddatatype                      <<06660>>53630000
   then segdescstinx:=objid(objidnumfield)&lsl(2) <<data seg>> <<06660>>53635000
   else segdescstinx:=convsegidtostinx(obj);                   <<06660>>53640000
   segdescsysbaseinx:=dstsysbaseinx+segdescstinx;              <<06212>>53645000
   x:=segdescsysbaseinx;                                       <<06212>>53650000
   segdescfirminfo.absentflag:=1;                              <<06212>>53655000
   if <> then suddendeath(614);                                <<06212>>53660000
   end;                                                        <<06212>>53665000
end;  <<subroutine markobjectabsent>>                          <<06212>>53670000
                                                               <<06212>>53675000
                                                               <<06212>>53680000
                                                                        53685000
subroutine markobjectpresent;                                  <<06212>>53690000
                                                               <<06212>>53695000
<< flags object as present and puts currentflipbase as address><<06212>>53700000
                                                               <<06212>>53705000
begin                                                          <<06212>>53710000
                                                               <<06212>>53715000
if objid(objidtypefield)=objidcdtype then                      <<06660>>53720000
   begin                                                       <<06212>>53725000
   if objid(objidnumfield)<> 0 then                            <<06660>>53730000
      begin  <<a mapped domain>>                               <<06212>>53735000
      cdt'abs'on'tos;                                          <<d7738>>53740000
      tos := tos + (objid(objidnumfield) * cdt'entry'size);    <<d7738>>53745000
      exchdb;                                                  <<d7738>>53750000
      cdt'array(cdt'md'flags).(cdt'abs'bit:1) := 0;            <<d7738>>53755000
      if = then suddendeath(sfkerncachesyncbad);               <<d7738>>53760000
      cdt'darray(cdt'md'mem'addr&asr(1)) := currentflipbase;   <<d7738>>53765000
      exchdb;   << back to original db >>                      <<d7738>>53770000
      asmb(ddel);  << get rid of abs md address >>             <<d7738>>53775000
      end;                                                     <<06212>>53780000
   end                                                         <<06212>>53785000
else                                                           <<06212>>53790000
   begin  <<a seg>>                                            <<06212>>53795000
                                                               <<06212>>53800000
   if objid(objidtypefield)=objiddatatype                      <<06660>>53805000
   then segdescstinx:=objid(objidnumfield)&lsl(2) <<data seg>> <<06660>>53810000
   else segdescstinx:=convsegidtostinx(obj);                   <<06660>>53815000
   segdescsysbaseinx:=dstsysbaseinx+segdescstinx;              <<06212>>53820000
   x:=segdescsysbaseinx;                                       <<06212>>53825000
   segdescfirminfo.absentflag:=0;                              <<06212>>53830000
   if = then suddendeath(614);                                 <<06212>>53835000
   tos := currentflipbase;                                     <<06212>>53840000
   segdescaddr:=tos;                                           <<06212>>53845000
   segdescbank:=tos;                                           <<06212>>53850000
   end;                                                        <<06212>>53855000
end;  <<subroutine markobjectpresent>>                         <<06212>>53860000
                                                               <<06212>>53865000
                                                               <<06212>>53870000
subroutine updatedescriptors;                                           53875000
                                                                        53880000
comment                                                                 53885000
                                                                        53890000
flips through the regions beginning with lowerboundbase                 53895000
and terminating at upperboundbase.  at each region,                     53900000
updates the corresponding object's descriptor address,         <<06212>>53905000
and marks the object present.                                  <<06212>>53910000
                                                                        53915000
;                                                                       53920000
                                                                        53925000
begin                                                                   53930000
                                                                        53935000
currentflipbase:=lowerboundbase;                                        53940000
disable;                                                                53945000
while currentflipbase <> upperboundbase or goonce do                    53950000
   begin                                                                53955000
   goonce:=false; <<degenerate case at end of bank>>                    53960000
   tos:=currentflipbase;                                                53965000
   tos:=tos+rbtorasdisp;                                                53970000
   asmb(lsea);                                                          53975000
   tos.regreservedflag:=0;                                              53980000
   if <> then suddendeath(614);                                <<01644>>53985000
   tos.regavailableflag:=0;                                             53990000
   if <> then asmb(del) else                                            53995000
      begin                                                             54000000
      tos.regassignedflag:=0;                                           54005000
                                                               <<06945>>54010000
      asmb(del);                                                        54015000
      if = then suddendeath(614);                              <<01644>>54020000
      tos:=tos+rastoobjidentdisp;                              <<06212>>54025000
      asmb(ldea);                                              <<06660>>54030000
      if = then suddendeath(614);                              <<01644>>54035000
      obj:=tos;                                                <<06660>>54040000
      asmb(ddel);                                              <<06212>>54045000
                                                               <<06212>>54050000
      <<if a cached disc region, link into cached region list>><<06212>>54055000
                                                               <<06212>>54060000
      if objid(objidtypefield)= objidcdtype                    <<06660>>54065000
      then linkcachedregion (currentflipbase);                 <<06212>>54070000
                                                               <<06212>>54075000
      << mark obj pres, put in new addr>>                      <<06212>>54080000
                                                               <<06212>>54085000
      markobjectpresent;                                       <<06212>>54090000
                                                               <<06212>>54095000
      << requeue deferred requests if a data seg>>             <<06212>>54100000
                                                               <<06212>>54105000
      if objid(objidtypefield) = objiddatatype                 <<07320>>54110000
      and dqh'disahead <> 0                                    <<06392>>54115000
      then checkfordeferreddiscreq(obj);                       <<06660>>54120000
                                                               <<06212>>54125000
      <<restore tos value for branch case>>                    <<06212>>54130000
                                                               <<06212>>54135000
                                                               <<06945>>54140000
      tos:=currentflipbase;                                             54145000
      tos:=tos+rbtorasdisp;                                             54150000
      end;                                                              54155000
   tos:=tos+rastorsdisp;                                                54160000
   asmb(lsea);                                                          54165000
   tos:=tos&lsl(pagepower);                                             54170000
   tos:=tos+rstorbdisp;                                                 54175000
   asmb(add);                                                           54180000
   currentflipbase:=tos;                                                54185000
   end;                                                                 54190000
enable;                                                                 54195000
end  <<updatedescriptors>>;                                             54200000
                                                                        54205000
                                                                        54210000
                                                                        54215000
subroutine combine;                                                     54220000
                                                                        54225000
comment                                                                 54230000
                                                                        54235000
flip through the regions below/above the current                        54240000
hole until the beginning/end of the bank or the prev/next available     54245000
region is reached, or until the distance flipped exceeds the            54250000
move threshold.  along the way, encntered segments are marked           54255000
absent.  if a locked, frozen, or iofrozen segment or a reserved         54260000
region is encntered, we giveup since we can't move over such            54265000
main memory domains.  if the base of the bank is encntered,             54270000
we giveup since we can't cross bank boundaries.  if we exceeded         54275000
the move threshold, then giveup.  otherwise, clean the                  54280000
prev/next hole.  if the prev/next hole has ongoing i/o then giveup.     54285000
                                                                        54290000
if we gaveup, then flip back down from the beginning and mark           54295000
all the intervening segments present again and return.  otherwise,      54300000
we will combine the two holes by moving all intervening assigned        54305000
regions down to the base of the previous hole.  when the move is        54310000
complete, update the new address of the intervening segments and        54315000
mark them present.                                                      54320000
                                                                        54325000
;                                                                       54330000
                                                                        54335000
begin                                                                   54340000
                                                                        54345000
movepagecnt:=0;                                                         54350000
moved:=giveup:=ready:=goonce:=can'tmove:=getready:=false;               54355000
                                                                        54360000
<< flip down/up until lower/upper hole or a giveup condition >>         54365000
                                                                        54370000
currentflipbase:=currentholebase;                                       54375000
while not giveup and not getready do                                    54380000
   begin <<prepare previous/next region in the bank>>                   54385000
   disable;                                                             54390000
   tos:=currentflipbase;                                                54395000
   if combinebelow then                                                 54400000
      begin                                                             54405000
      if ls0 < ptrastorbdisp or firstmemoryaddress=currentflipbase then 54410000
         begin  <<first region in bank>>                                54415000
         lowerboundbase:=tos;                                           54420000
         giveup:=true;                                                  54425000
         end                                                            54430000
      else                                                              54435000
         begin <<determine next flip base>>                             54440000
         tos:=tos+rbtoptrsdisp;                                         54445000
         asmb(lsea);                                                    54450000
         tos:=tos&lsl(pagepower);                                       54455000
         asmb(lsub);                                                    54460000
         tos:=tos+ptrstorbdisp;                                         54465000
         nextflipbase:=tos;                                             54470000
         end;                                                           54475000
      end                                                               54480000
   else                                                                 54485000
      begin  <<combine above>>                                          54490000
      << determine if this is the last region in the bank>>             54495000
      tos:=tos+rbtorsdisp;                                              54500000
      asmb(lsea);                                                       54505000
      if s0=maxholesize then suddendeath(614);                 <<01788>>54510000
      tos:=tos&lsl(pagepower);                                          54515000
      tos:=tos+rstorbdisp;                                              54520000
      asmb(ladd);                                                       54525000
      if carry then                                                     54530000
         begin  <<last region in bank>>                                 54535000
         giveup:=true;                                                  54540000
         upperboundbase:=tos;                                           54545000
         if currentflipbase <> currentholebase then goonce:=true;       54550000
         end                                                            54555000
      else nextflipbase:=tos;                                           54560000
      if nextflipbase >= lastmemoryaddress and not giveup then <<01616>>54565000
         begin  <<past last half-bank>>                                 54570000
         giveup:=true;                                                  54575000
         upperboundbase:=nextflipbase;  <<for update desc>>             54580000
         if currentflipbase <> currentholebase then goonce:=true;       54585000
         end;                                                           54590000
      end;                                                              54595000
   if not giveup then                                                   54600000
      begin                                                             54605000
      tos:=nextflipbase;                                                54610000
      tos:=tos+rbtorsdisp;                                              54615000
      asmb(lsea);                                                       54620000
      thisregionsize:=tos;                                              54625000
      tos:=tos+rstorasdisp;                                             54630000
      asmb(lsea);                                                       54635000
      if ls0.regavailableflag then                                      54640000
         begin                                                          54645000
         asmb(del,ddel);                                                54650000
         if combinebelow then                                           54655000
            begin  <<got the next hole below>>                          54660000
            lowerholesize:=thisregionsize;                              54665000
            lowerboundbase:=lowerholebase:=nextflipbase;                54670000
            end                                                         54675000
         else                                                           54680000
            begin  <<got the next hole above>>                          54685000
            upperholesize:=thisregionsize;                              54690000
            upperboundbase:=upperholebase:=nextflipbase;                54695000
            end;                                                        54700000
         if nextflipbase = nextcandbase then                            54705000
            begin <<get a new next candidate hole>>                     54710000
            tos:=nextflipbase;                                          54715000
            tos := tos + rbtopldisp;                           <<*7566>>54720000
            asmb(ldea);                                                 54725000
            if = then nextcandbase := tos else                 <<06945>>54730000
               begin                                           <<06945>>54735000
               tos := tos + pltorbdisp;                        <<*7566>>54740000
               nextcandbase := tos;                            <<06945>>54745000
               end;                                            <<06945>>54750000
            asmb(ddel);                                                 54755000
            end;                                                        54760000
         getready:=true;                                                54765000
         if combineabove then                                           54770000
            begin                                                       54775000
            takeoffarl(upperholebase,upperholesize);                    54780000
            combinedholebase:=currentholebase;                          54785000
            combinedholesize:=upperholesize+currentholesize+movepagecnt;54790000
            end                                                         54795000
         else                                                           54800000
            begin <<combinebelow>>                                      54805000
            takeoffarl(lowerholebase,lowerholesize);                    54810000
            combinedholebase:=lowerholebase;                            54815000
            combinedholesize:=lowerholesize+currentholesize+movepagecnt;54820000
            end;                                                        54825000
         end                                                            54830000
      else                                                              54835000
         begin  <<reserved or assigned>>                                54840000
         movepagecnt:=movepagecnt+thisregionsize;                       54845000
         tos.regreservedflag:=0;                                        54850000
         if <> then can'tmove:=true;                                    54855000
         tos:=tos.regnonmoveflags;                                      54860000
         asmb(del);                                                     54865000
         if <> then can'tmove:=true;                                    54870000
                                                               <<06411>>54875000
         << if write pending on cache, don't move >>           <<06411>>54880000
         tos := tos + rastowreqpdisp;                          <<06411>>54885000
         asmb(lsea;del);                                       <<06411>>54890000
         if <> then can'tmove := true;                         <<06411>>54895000
         tos := tos + wreqptorasdisp; << restore pointer >>    <<06411>>54900000
                                                               <<06411>>54905000
         <<look up objid in region header>>                    <<06411>>54910000
         tos := tos+rastoobjidentdisp;                         <<06411>>54915000
         asmb(ldea);                                           <<06660>>54920000
         obj := tos;                                           <<06660>>54925000
         asmb(ddel);  <<get rid of addr for sub exit>>         <<06411>>54930000
                                                               <<06411>>54935000
         << if object is current process' stk or xds, skip>>   <<06411>>54940000
         if curprc <> 0                                        <<06650>>54945000
         and (integer(objid(objidnumfield)) =                  <<06660>>54950000
              ics(-ics'stkdstcell) or objid(objidnumfield) =   <<06660>>54955000
         lpcb(curprc+dbxdsinfowordnum).xdsdstfield or          <<07320>>54960000
         objid(objidnumfield) = lpcb(curprc+mapdstwordnum))    <<07320>>54965000
      then can'tmove := true;                                  <<07320>>54970000
                                                               <<07320>>54975000
         if ls0 < ptrastorbdisp or can'tmove                            54980000
         or movepagecnt > movethreshold then                            54985000
            begin <<can't go through this region>>                      54990000
            giveup:=true;                                               54995000
            if combinebelow then lowerboundbase:=currentflipbase        55000000
            else upperboundbase:=nextflipbase;                          55005000
            end                                                         55010000
         else                                                           55015000
            begin <<this guy can be moved>>                    <<06212>>55020000
            <<if a cached disc domain, take region off cached>><<06660>>55025000
            << domain list.                                  >><<06660>>55030000
                                                               <<06212>>55035000
            if objid(objidtypefield)= objidcdtype              <<06660>>55040000
            then unlinkcachedregion (nextflipbase);            <<06212>>55045000
                                                               <<06212>>55050000
            <<flag object absent in object's descriptor>>      <<06212>>55055000
                                                               <<06212>>55060000
            markobjectabsent;                                  <<06212>>55065000
            end;                                               <<06212>>55070000
                                                               <<06212>>55075000
                                                               <<06212>>55080000
                                                               <<06212>>55085000
         end;                                                           55090000
      end;                                                              55095000
   currentflipbase:=nextflipbase;                                       55100000
   end;                                                                 55105000
if getready then                                                        55110000
   begin <<select a destination hole for segments between the holes>>   55115000
   if movepagecnt > maxavailreg then tos:=0d                            55120000
   else tos := reserveregion(movepagecnt,combinedholesize,     <<06945>>55125000
                 bkgrndpri-1,garbcollcode,currentholebase);    <<06945>>55130000
   asmb(dtst);                                                          55135000
   destholebase:=tos;                                                   55140000
   if = then ready:=false else                                          55145000
      begin  <<got a destination hole>>                                 55150000
      tos:=destholebase;                                                55155000
      tos:=tos+rbtoinitmsgdisp;                                         55160000
      asmb(lsea);                                                       55165000
      tos.msgongoingiodisabledflag:=0;                                  55170000
      asmb(del,ddel);                                                   55175000
      if <> then ready:=false else ready:=true;                         55180000
      end;                                                              55185000
   if not ready then                                                    55190000
      begin  <<return holes>>                                           55195000
      if destholebase<>0d then                                 <<06212>>55200000
         begin <<release hole, zero objid if necessary>>       <<06212>>55205000
         disable; <<freeze the action>>                        <<06212>>55210000
         tos:=destholebase;                                    <<06212>>55215000
         tos:=tos+rbtoobjidentdisp;                            <<06212>>55220000
         asmb(ldea;dtst);                                      <<06660>>55225000
         if = then asmb(ddel,ddel) else                        <<06660>>55230000
            begin<<a data object in motion out>>               <<06212>>55235000
            if s1.objidtype <> objiddatatype  and              <<07320>>55240000
               s1.objidtype <> objidcdtype                     <<07320>>55245000
            then suddendeath(sfkerncacheintbad);               <<06212>>55250000
               asmb(ddel);                                     <<06748>>55255000
            tos:=tos+objidenttowreqpdisp;                      <<06212>>55260000
            asmb(lsea;del);                                    <<06212>>55265000
            if <> then asmb(ddel) <<obj still needed>>else     <<06212>>55270000
               begin <<write completed so zap objident>>       <<06212>>55275000
               tos:=tos+wreqptoobjidentdisp;                   <<06212>>55280000
               tos:=0d;                                        <<06660>>55285000
               asmb(sdea;ddel);                                <<06660>>55290000
               end;                                            <<06212>>55295000
            end;                                               <<06212>>55300000
         releaseregion(destholebase,0);                        <<06212>>55305000
         end;                                                  <<06212>>55310000
      if combineabove then                                              55315000
         begin                                                          55320000
         upperboundbase:=nextflipbase;                                  55325000
         releaseregion(upperholebase,0);                                55330000
         end                                                            55335000
      else                                                              55340000
         begin                                                          55345000
         lowerboundbase:=nextflipbase;                                  55350000
         releaseregion(lowerholebase,0);                                55355000
         end;                                                           55360000
      end                                                               55365000
   else                                                                 55370000
      begin <<do the move>>                                             55375000
      startover:=true;                                                  55380000
      takeoffarl(currentholebase,currentholesize);             <<06945>>55385000
      moved:=true;                                                      55390000
                                                                        55395000
      <<set up for the move>>                                           55400000
                                                                        55405000
      enable;                                                           55410000
                                                                        55415000
<<bc>>tos:=destholebase;                                                55420000
      tos:=tos+rbtorsdisp;                                              55425000
      asmb(lsea);                                                       55430000
      tos:=movepagecnt;                                                 55435000
      asmb(cmp);                                                        55440000
      if <> then suddendeath(619);                             <<01644>>55445000
      asmb(ddel);                                                       55450000
                                                               <<01788>>55455000
      tos:=destholebase;                                                55460000
      tos:=tos+rbtorasdisp; <<destination>>                             55465000
      if combinebelow then                                              55470000
         begin                                                          55475000
         if lowerholebase < scanpoint and                               55480000
         scanpoint <=currentholebase then scanpoint:=combinedholebase;  55485000
         tos:=lowerholebase;                                            55490000
         tos:=lowerholesize&lsl(pagepower);                             55495000
         asmb(ladd);                                                    55500000
         tos:=tos+rbtorasdisp;  <<source for move>>                     55505000
         asmb(ddup);                                                    55510000
         movesource:=tos;                                               55515000
         end                                                            55520000
      else                                                              55525000
         begin <<combineabove>>                                         55530000
         if currentholebase < scanpoint and                             55535000
         scanpoint <= upperholebase then scanpoint:=combinedholebase;   55540000
         tos:=currentholebase;                                          55545000
         tos:=currentholesize&lsl(pagepower);                           55550000
         asmb(ladd);                                                    55555000
         tos:=tos+rbtorasdisp;                                          55560000
         asmb(ddup); <<source for move>>                                55565000
         movesource:=tos;                                               55570000
         end;                                                           55575000
      tos:=movepagecnt&lsl(pagepower);                                  55580000
      asmb(mabs 5);  <<fire away>>                             <<01788>>55585000
                                                               <<01788>>55590000
      <<make an mmstat record>>                                <<01788>>55595000
                                                               <<01788>>55600000
      tos:=mmstatcgarbage; <<event number>>     <<***>>        <<06948>>55605000
      tos:=movesource; <<***>>                                 <<06948>>55610000
      tos:=movepagecnt; <<***>>                                <<06948>>55615000
      mmstat'(*,*,*,*,0,0,0);                                  <<06948>>55620000
                                                                        55625000
<<bc>> tos:=movesource;                                                 55630000
       asmb(lsea);                                                      55635000
       tos.regassignedflag:=1;                                          55640000
       if = then suddendeath(614);                             <<01644>>55645000
       asmb(del,ddel);                                                  55650000
                                                                        55655000
      <<fix up the combined hole>>                                      55660000
                                                                        55665000
      tos:=movesource;                                                  55670000
      tos:=regavailablecode;                                            55675000
      asmb(ssea);                                                       55680000
      tos:=tos+rastorsdisp;                                             55685000
      tos:=movepagecnt;                                                 55690000
      asmb(ssea);                                                       55695000
      tos:=tos+rstossdisp;                                              55700000
      tos:=movepagecnt;                                                 55705000
      asmb(ssea);                                                       55710000
      tos:=tos+sstoobjidentdisp;                               <<06212>>55715000
      tos:=0d;                                                 <<06660>>55720000
      asmb(sdea);                                              <<06660>>55725000
      tos:=tos+objidenttoptrasdisp;                            <<06212>>55730000
      tos:=movepagecnt&lsl(pagepower);                                  55735000
      asmb(ladd);                                                       55740000
      tos:=regavailablecode;                                            55745000
      asmb(ssea);                                                       55750000
      tos:=tos+trastotrsdisp;                                           55755000
      tos:=movepagecnt;                                                 55760000
      asmb(ssea);                                                       55765000
      tos:=tos+trstotssdisp;                                            55770000
      tos:=movepagecnt;                                                 55775000
      asmb(ssea);                                                       55780000
      asmb(ddel);                                                       55785000
                                                                        55790000
      <<fill in the proper header information>>                         55795000
                                                                        55800000
      tos:=combinedholebase;                                            55805000
      tos:=tos+rbtorsdisp;                                              55810000
      tos:=combinedholesize;                                            55815000
      asmb(ssea);                                                       55820000
                                                                        55825000
      <<now fix up the trailer>>                                        55830000
                                                                        55835000
      tos:=rstoptrsdisp+combinedholesize&lsl(pagepower);                55840000
      asmb(ladd);                                                       55845000
      tos:=combinedholesize;                                            55850000
      asmb(ssea);                                                       55855000
      asmb(ddel);                                                       55860000
                                                                        55865000
      <<new current hole>>                                              55870000
                                                                        55875000
      currentholebase:=combinedholebase;                                55880000
      currentholesize:=combinedholesize;                                55885000
      end;                                                              55890000
   end;                                                                 55895000
                                                                        55900000
<< update addresses of moved segments, mark segments present >>         55905000
                                                                        55910000
if moved then                                                           55915000
   begin                                                                55920000
   if gclassenabledmask.class0 then                                     55925000
      begin  <<measure move event>>                                     55930000
      tos:=measstatxdsbank;                                             55935000
      tos:=measstatxdsbase;                                             55940000
      tos:=tos+c0sub0'segreloff;                                        55945000
      if singleholebase=0d then tos:=tos+c'garbmovebkrnd       <<ray.v>>55950000
         else tos:=tos+c'garbmoveallocate;                     <<ray.v>>55955000
      asmb(lsea;inca;ssea;ddel);                                        55960000
      end;                                                              55965000
   lowerboundbase:=destholebase;                                        55970000
   tos:=destholebase;                                                   55975000
   tos:=movepagecnt&lsl(pagepower);                                     55980000
   asmb(ladd);                                                          55985000
   upperboundbase:=tos;                                                 55990000
   end                                                                  55995000
else                                                                    56000000
   begin                                                                56005000
   if combinebelow then upperboundbase:=currentholebase                 56010000
   else lowerboundbase:=currentholebase;                                56015000
   end;                                                                 56020000
updatedescriptors;                                                      56025000
enable;                                                                 56030000
                                                                        56035000
end <<subroutine combine>>;                                             56040000
                                                                        56045000
<<begin outer block of garbage collection>>                             56050000
                                                                        56055000
if gclassenabledmask.class0 then savetime:=timer;                       56060000
startover:=true;                                                        56065000
tos:=firstmembank;                                                      56070000
tos:=firstmembase;                                                      56075000
firstmemoryaddress:=tos;                                                56080000
while curractpri <= awaketoschedmsg and currentholesize <> 0 do         56085000
   begin                                                                56090000
   selectnextcand;                                                      56095000
   if currentholesize <> 0 then                                         56100000
      begin  <<gotone>>                                                 56105000
      combinebelow:=true;                                               56110000
      combineabove:=false;                                              56115000
      combine;                                                          56120000
      if moved then                                            <<06945>>56125000
         putonarl(currentholebase,currentholesize,putatend);   <<06945>>56130000
      if curractpri <= awaketoschedmsg and currentholesize     <<01788>>56135000
      <> maxholesize then                                      <<01788>>56140000
         begin <<time to combine above>>                                56145000
         combinebelow:=false;                                           56150000
         combineabove:=true;                                            56155000
         combine;                                                       56160000
         if moved then                                         <<06945>>56165000
            putonarl(currentholebase,currentholesize,putatend);<<06945>>56170000
         end;                                                           56175000
      end;                                                              56180000
   end;                                                                 56185000
if gclassenabledmask.class0  then                                       56190000
   begin  <<measure garb coll event & duration>>                        56195000
   tos:=measstatxdsbank;                                                56200000
   tos:=measstatxdsbase;                                                56205000
   tos:=tos+c0sub0'segreloff;                                           56210000
   if singleholebase=0d then tos:=tos+c'cpugarbage             <<ray.v>>56215000
      else tos:=tos+c'cpuallocgarb;                            <<ray.v>>56220000
   asmb(ldea);                                                          56225000
   tos:=timer-savetime;                                                 56230000
   asmb(dadd;sdea);                                                     56235000
   if singleholebase=0d then                                   <<ray.v>>56240000
       begin                                                   <<ray.v>>56245000
       tos:=tos-c'cpugarbage+c'garbagecnt;<<use addr on tos>>  <<ray.v>>56250000
       asmb(lsea);                                             <<ray.v>>56255000
       tos:=tos+1;                                             <<ray.v>>56260000
       asmb(ssea);                                             <<ray.v>>56265000
       end;                                                    <<ray.v>>56270000
   if curractpri > awaketoschedmsg then                                 56275000
      begin <<preempted>>                                               56280000
      asmb(del);                                                        56285000
      tos:=measstatxdsbase;                                             56290000
      tos:=tos+c0sub0'segreloff+c'garbgiveuppreempt;           <<ray.v>>56295000
      asmb(lsea;inca;ssea);                                   <<ray.v>> 56300000
      end;                                                              56305000
   asmb(ddel);                                                 <<ray.v>>56310000
   end;                                                                 56315000
end  <<collectgarbage>>;                                                56320000
                                                                        56325000
$page "PROCESS SCHEDULER MESSAGES"                                      56330000
procedure processschedmsgs;                                             56335000
option privileged,uncallable;                                           56340000
                                                                        56345000
comment                                                                 56350000
                                                                        56355000
processschedmsgs is called by a cpu's dispatcher to service             56360000
requests for releasing regions, performing moves or fetching            56365000
segments for i/o device monitors.  these requests were generated        56370000
on the ics, but couldn't be completed there.                            56375000
                                                                        56380000
processschedmsgs returns condcode=cce if all messages were     <<01557>>56385000
successfully processed, and condcode=ccl if a fetchobject requ<<<06212>>56390000
for the i/o system failed due to lack of space.                <<01557>>56395000
                                                               <<01557>>56400000
;                                                                       56405000
                                                                        56410000
begin                                                                   56415000
integer mosturgportnum,                                                 56420000
        reqprocinx,                                                     56425000
        pcbpt,                                                 <<06650>>56430000
        ioqinx,                                                <<06392>>56435000
        cdtentrynumber,                                        <<06212>>56440000
        xferstatus,                                            <<06212>>56445000
        reqcode,                                               <<06212>>56450000
        descstinx;                                                      56455000
logical specialflags;                                                   56460000
double  obj;                                                   <<06660>>56465000
logical array objident(*)=obj;                                 <<06660>>56470000
double regionbase;                                                      56475000
integer specreqindex,                                                   56480000
        prev'specreq,     << for scanning queue >>             <<01559>>56485000
        newsize,                                                        56490000
        readdisp,                                                       56495000
        movelength;                                                     56500000
integer oldsize;                                               <<01557>>56505000
integer condcode:=cce;                                         <<01557>>56510000
double                                                         <<06616>>56515000
   savedb;                                                     <<06660>>56520000
                                                               <<06620>>56525000
integer                                                        <<06616>>56530000
   save'specqhead;                                             <<06616>>56535000
                                                                        56540000
                                                               <<06212>>56545000
subroutine handlecachemovereq;                                 <<06212>>56550000
                                                               <<06212>>56555000
                                                               <<06212>>56560000
begin                                                          <<06212>>56565000
asmb(adds 3);                                                  <<06212>>56570000
receivemsg(x,3,0);                                             <<06212>>56575000
if <> then suddendeath(620);                                   <<06212>>56580000
enable;                                                        <<06212>>56585000
reqcode:=tos;                                                  <<06212>>56590000
xferstatus:=tos;                                               <<06212>>56595000
cdtentrynumber:=tos;                                           <<06212>>56600000
if reqcode=cachemovereadycode                                  <<06212>>56605000
then processcdtlogreqq(cdtentrynumber,xferstatus,0)            <<06212>>56610000
else if reqcode = cachewritedonecode                           <<06212>>56615000
then cachewritecomp(cdtentrynumber,xferstatus)                 <<06212>>56620000
else suddendeath(sfkerncacheintbad);                           <<06212>>56625000
end; <<subroutine handlecachemovereq>>                         <<06212>>56630000
                                                               <<06212>>56635000
subroutine handleiosegreq;                                     <<06212>>56640000
                                                               <<06212>>56645000
begin                                                          <<06212>>56650000
asmb(adds 4);                                                  <<06660>>56655000
receivemsg(x,4,nondestructread);                               <<06660>>56660000
if <> then suddendeath(620);                                   <<06212>>56665000
enable;                                                        <<06212>>56670000
tos:=0;                                                        <<06212>>56675000
tos.iosysreqflag:=1;                                           <<06212>>56680000
specialflags:=tos;                                             <<06212>>56685000
tos.msgiofzreqflag:=0;                                         <<06212>>56690000
if <> then specialflags.iofzreqflag:=1;                        <<06212>>56695000
asmb(del);                                                     <<06212>>56700000
ioqinx:=tos;                                                   <<06392>>56705000
obj:=tos;                                                      <<06660>>56710000
tos:=fetchobject(obj,ioqinx,specialflags,                      <<06660>>56715000
                 noinfo,true);                                 <<06212>>56720000
if tos<>mmok then condcode:=ccl <<won't fit now>> else         <<06212>>56725000
   begin <<success>>                                           <<06212>>56730000
   if dst(x:=convsegidtostinx(obj)).absentflag=0               <<06660>>56735000
   then awakedevice(ioqinx,obj,iostatusok);                    <<06945>>56740000
   asmb(adds 4); <<some room for message>>                     <<06660>>56745000
   receivemsg(iosegreqport,4,0);                               <<06660>>56750000
   if <> then suddendeath(620);                                <<06212>>56755000
   asmb(ddel,ddel); <<finished it off>>                        <<06660>>56760000
   end;                                                        <<06212>>56765000
end;  <<subroutine handleiosegreq>>                            <<06212>>56770000
                                                               <<06212>>56775000
                                                               <<06212>>56780000
disable;                                                                56785000
mosturgportnum:=portstatus(-1);                                         56790000
while <> do                                                             56795000
   begin  <<got a message>>                                             56800000
   x:=mosturgportnum;                                                   56805000
   case *x of    <<switch to the service routine for the port>><<06660>>56810000
      begin                                                    <<06660>>56815000
        go to  makeabsentportservice;                          <<06660>>56820000
        go to  movereqportservice;                             <<06660>>56825000
        go to  relregreqportservice;                           <<06660>>56830000
        go to  iosegreqportservice;                            <<06660>>56835000
        go to  cachemovereqportservice;                        <<06660>>56840000
      end;                                                     <<06660>>56845000
                                                                        56850000
   makeabsentportservice:                                               56855000
      asmb(adds 3);                                            <<06660>>56860000
      receivemsg(x,3,0);                                       <<06660>>56865000
      if <> then suddendeath(620);                                      56870000
      reqprocinx:=tos;                                                  56875000
      obj := tos;                                              <<06660>>56880000
      if objident(objidtypefield) <> objiddatatype             <<06660>>56885000
         then suddendeath(619);                                <<06660>>56890000
      descstinx := objident(objidnumfield) & lsl(2);           <<06660>>56895000
      dst(descstinx+1).segmodreqflag:=1;                                56900000
      dst(x).fwipflag:=1;                                               56905000
      pcbpt := reqprocinx;                                     <<06650>>56910000
      tos:=sllptr;                                                      56915000
      tos:=obj;                                                <<06660>>56920000
      tos:=0;                                                           56925000
      if stkinfo.stkdstfield=objident then tos.procsstkflag:=1;<<06212>>56930000
      tos.setmemreqptrflag:=1;                                          56935000
      addtolocality(*,*,*);                                             56940000
      x:=dstsysbaseinx+descstinx;                                       56945000
      segdescfirminfo.absentflag:=1;                                    56950000
      tos:=segdescbank;                                                 56955000
      tos:=segdescaddr;                                                 56960000
      regionbase:=tos;                                         <<06212>>56965000
      releaseregion(regionbase,0);                             <<06212>>56970000
      enable;                                                           56975000
      <<get write going>>                                      <<01816>>56980000
      startobjwrite(obj,forcedwritepri,regionbase,0,0);        <<06660>>56985000
      <<replace memory addr with disc addr in descriptor>>     <<01816>>56990000
      tos:=segdescbank;                                        <<01816>>56995000
      tos:=segdescaddr;                                        <<01816>>57000000
      tos:=tos+rbtohodadisp;                                   <<01816>>57005000
      asmb(ldea);                                              <<01816>>57010000
      segdescloda:=tos;                                        <<01816>>57015000
      segdeschoda:=tos;                                        <<01816>>57020000
      asmb(ddel);                                              <<01816>>57025000
      go checkformoremsgs;                                              57030000
                                                                        57035000
   movereqportservice:                                                  57040000
      asmb(adds 2);                                            <<06660>>57045000
      receivemsg(x,2,0);                                       <<06660>>57050000
      if <> then suddendeath(620);                                      57055000
      enable;                                                           57060000
      obj := tos;                                              <<06660>>57065000
      if objident(objidtypefield) <> objiddatatype             <<06660>>57070000
         then suddendeath(619);                                <<06660>>57075000
      descstinx := objident(objidnumfield) & lsl(2);           <<06660>>57080000
      dst(x:=descstinx+1).segmodreqflag:=0;                             57085000
      if = then suddendeath(619);                              <<01644>>57090000
                                                                        57095000
      <<find out parameters for move>>                                  57100000
                                                                        57105000
      tos := save'specqhead := specqhead;                      <<06616>>57110000
      tos := dst(specreqdst&lsl(2) + 2); << bank >>            <<06616>>57115000
      tos := dst(x + 1);                                       <<06616>>57120000
      asmb(xchd);                                              <<06616>>57125000
      savedb := tos;                                           <<06616>>57130000
                                                               <<06620>>57135000
      x := tos & lsr(1);     << double index >>                <<06620>>57140000
      << search for needed special request entry >>            <<01559>>57145000
      while dentryword01 <> obj do                             <<06660>>57150000
         begin                                                 <<01559>>57155000
         prev'specreq := x := x & lsl(1);  << single index >>  <<06620>>57160000
         x := entryword00;      << ptr to next entry >>        <<01559>>57165000
         x := x & lsr(1);           << double index >>         <<06620>>57170000
         end;                                                  <<01559>>57175000
      << delink the special request entry from the queue >>    <<01559>>57180000
      x := x & lsl(1);        << single index >>               <<06620>>57185000
      specreqindex := x;                                       <<01559>>57190000
      if x = save'specqhead then                               <<06616>>57195000
         begin                                                 <<06616>>57200000
         tos := entryword00;                                   <<06616>>57205000
         tos := %1000d;                                        <<06616>>57210000
         asmb(xchd);                                           <<06616>>57215000
         savedb := tos;                                        <<06616>>57220000
         specqhead := tos;                                     <<06616>>57225000
         tos := savedb;                                        <<06616>>57230000
         asmb(xchd);                                           <<06616>>57235000
         savedb := tos;                                        <<06616>>57240000
         end                                                   <<06616>>57245000
      else                                                     <<01559>>57250000
         begin                                                 <<01559>>57255000
         tos := entryword00;    << ptr to next entry >>        <<01559>>57260000
         x := prev'specreq;     << point to prev entry >>      <<01559>>57265000
         entryword00 := tos;    << delink - set new next ptr >><<01559>>57270000
         end;                                                  <<01559>>57275000
      x := specreqindex;        << point to special req >>     <<01559>>57280000
      newsize:=entryword03;                                    <<06620>>57285000
      readdisp:=entryword04;                                   <<06620>>57290000
      movelength:=entryword05;                                 <<06620>>57295000
      relsystabentry(specreqdst,specreqindex);                 <<06616>>57300000
      oldsize:=dst(descstinx).datasizefield;                   <<01557>>57305000
      dst(descstinx).datasizefield:=newsize;                            57310000
      tos:=dst(x:=x+2);                                                 57315000
      tos:=dst(x:=x+1);                                                 57320000
      regionbase:=tos;                                                  57325000
      if logical(dst(x:=descstinx+1)).stkflag then                      57330000
         begin <<check for internal moves required>>                    57335000
         if movelength <> 0 then                                        57340000
            begin <<pcbx move required>>                                57345000
            tos:=regionbase;                                            57350000
            asmb(ddup);                                                 57355000
            tos:=tos+readdisp; <<source addr>>                          57360000
            tos:=movelength; <<signed move count>>                      57365000
            asmb(mabs 5);                                               57370000
            <<zero out the expanded area>>                     <<01557>>57375000
            tos:=regionbase;                                   <<01557>>57380000
            tos:=tos+movelength+1;     <<dest. for zeroing out><<01557>>57385000
            asmb(ddup,deca);      <<source for zeroing out>>   <<01557>>57390000
            tos:=0;                                            <<01557>>57395000
            asmb(ssea);      <<zero first word for template>>  <<01557>>57400000
            tos:=readdisp-1; <<# words to zero out w/ move>>   <<01557>>57405000
            asmb(mabs 5);                                      <<01557>>57410000
            end;                                                        57415000
         end;                                                           57420000
      <<zero out expanded area>>                               <<01557>>57425000
      if movelength = 0 then                                   <<01557>>57430000
         begin <<expanded segment on the end>>                 <<01557>>57435000
         tos:=regionbase;                                      <<01557>>57440000
         tos:=tos+oldsize&lsl(2)+1; <<destination>>            <<01557>>57445000
         asmb(ddup,deca); <<source>>                           <<01557>>57450000
         tos:=0;                                               <<01557>>57455000
         asmb(ssea); <<template for move>>                     <<01557>>57460000
         tos:=(newsize&lsl(2)-oldsize&lsl(2))-1; <<movecnt>>   <<01557>>57465000
         asmb(mabs 5);                                         <<01557>>57470000
         end;                                                  <<01557>>57475000
      disable;                                                          57480000
      tos := savedb;                                           <<06616>>57485000
      asmb(xchd);                                              <<06616>>57490000
      ddel;                                                    <<06616>>57495000
     processcompmsg(regionbase,obj,descstinx,iostatusok);      <<06660>>57500000
      go checkformoremsgs;                                              57505000
                                                                        57510000
   relregreqportservice:                                                57515000
      asmb(adds 2); <<for region base>>                                 57520000
      receivemsg(x,2,0);                                                57525000
      if <> then suddendeath(620);                             <<01644>>57530000
      enable;                                                           57535000
      releaseregion(*,0);                                               57540000
      go checkformoremsgs;                                              57545000
                                                                        57550000
   iosegreqportservice:                                                 57555000
      handleiosegreq;                                          <<06212>>57560000
      go checkformoremsgs;                                              57565000
                                                                        57570000
   cachemovereqportservice:                                    <<06212>>57575000
      handlecachemovereq;                                      <<06212>>57580000
      go checkformoremsgs;                                     <<06212>>57585000
                                                               <<06212>>57590000
                                                               <<06212>>57595000
   checkformoremsgs:                                                    57600000
      disable;                                                          57605000
      mosturgportnum:=portstatus(-1);                                   57610000
   end;                                                                 57615000
cc:=condcode;                                                  <<01557>>57620000
end  <<processschedmsgs>>;                                              57625000
                                                                        57630000
$page "DISPATCHER"                                                      57635000
procedure dsp;                                                          57640000
option privileged,uncallable;                                           57645000
                                                                        57650000
                                                                        57655000
comment                                                                 57660000
                                                                        57665000
the dispatcher is launched via microcode soon after the                 57670000
execution of a disp instruction (when the pdisable                      57675000
count falls to zero).  although implemented as a proce-                 57680000
dure, dispatcher may not be pcaled since process                        57685000
switching may be disabled levels deep unknown to the                    57690000
caller, and the user's stk, the ics, and the dispatcer                  57695000
db and entry point must be set up by the microcode for                  57700000
the dispatcher environment to be properly initialized.                  57705000
                                                                        57710000
the dispatcher has two functions: i). saving the register               57715000
state, rescheduling, and updating and accounting for the                57720000
usage of the cpu, main memory and disc resources of the last            57725000
launched process, and ii). selecting and initiating the next            57730000
most urgent cpu activity (launching a process if that is the            57735000
most urgent pending activity, reserving memory regions                  57740000
for a process if it had trapped or it's deemed safe to try              57745000
to increase the multiprogramming level, fix up memory                   57750000
through garbage collection if that's deemed the most worth-             57755000
while thing to do for the time being, or pause if there's               57760000
nothing worthwhile to do).                                              57765000
                                                                        57770000
;                                                                       57775000
                                                                        57780000
                                                                        57785000
begin                                                                   57790000
                                                                        57795000
                                                                        57800000
<<firmware assignments in q-0 thru q-31>>                               57805000
                                                                        57810000
integer ics'pdisabledcnt=q-ics'pdiscntcell,                             57815000
        ics'stkdst=q-ics'stkdstcell,                                    57820000
        ics'pistatus=q-ics'pistatuscell,                                57825000
        ics'pideltap=q-ics'pideltapcell,                                57830000
        ics'curprocpcbpt=q-ics'curpcbptcell,                            57835000
        ics'stkbase=q-ics'stkbasecell,                                  57840000
        ics'stkdbrelz=q-ics'stkdbrelzcell,                              57845000
        ics'stkdbreldl=q-ics'stkdbreldlcell,                            57850000
        ics'stkdbrels=q-ics'stkdbrelscell,                              57855000
        ics'stkbank=q-ics'stkbankcell,                                  57860000
        ics'absstkdb=q-ics'absstkdbcell;                                57865000
                                                                        57870000
<< software assignments in q-32 through q-63 >>                         57875000
                                                                        57880000
integer worstcpri=q-ics'worstcpricell, <<c,d,e scheduling limits>>      57885000
        worstdpri=q-ics'worstdpricell,                                  57890000
        worstepri=q-ics'worstepricell,                                  57895000
        cschedbase=q-ics'cschedbasecell, <<c,d,e scheduling bases>>     57900000
        dschedbase=q-ics'dschedbasecell,                                57905000
        eschedbase=q-ics'eschedbasecell;                                57910000
logical mincfilter=q-ics'mincfiltercell, <<c,d,e scheduling filters>>   57915000
        maxcfilter=q-ics'maxcfiltercell,                                57920000
        currentcfilter=q-ics'curcfiltercell,                            57925000
        denom=q-ics'cwtdenomcell,                              <<01840>>57930000
        oldfilter'wt=q-ics'cwtoldfiltwtcell,                   <<01840>>57935000
        backgroundfilter=q-ics'curdfiltercell,                          57940000
        efilter=q-ics'curefiltercell,                                   57945000
        liststate=q-ics'liststatecell,<<measurement cells>>    <<01812>>57950000
        candpin=q-ics'candpincell;                             <<01812>>57955000
double  savepausetime=q-ics'pausetimecell; <<double>>                   57960000
logical lasttrans'wt=q-ics'cwtlasttranswtcell;                 <<01840>>57965000
                                                                        57970000
integer lastprocinx=q+4,                                                57975000
        laststksysbaseinx=q+5,                                          57980000
        lastprocnewpri=q+6,                                             57985000
        incoreprotectcnt=q+7,                                           57990000
        launchprocinx=q+8,                                              57995000
        bptinx=q+9;                                                     58000000
                                                                        58005000
logical swapinprocinx=q+10,                                             58010000
        hardrequest=q+11;                                               58015000
                                                                        58020000
integer moreurgentswcnt=q+12,                                           58025000
        lastprocnewprioffset=q+13;                                      58030000
                                                                        58035000
equate  worstpri=256;                                                   58040000
                                                                        58045000
logical quantumout=q+15,                                                58050000
        piflag=q+16;                                                    58055000
                                                                        58060000
double  laststkaddr=q+17,                                               58065000
        launchstkaddr=q+19,                                             58070000
        launchdb=q+21;                                                  58075000
                                                                        58080000
logical dontdeallocate=q+23;                                            58085000
logical stkreldb=q+24;                                                  58090000
integer candprocinx=q+25;                                               58095000
integer pcbpt = q + 48;                                        <<06650>>58100000
integer swapfence=q+27;                                                 58105000
logical swapdelay=q+28;                                                 58110000
logical memorypressure=q+30;                                            58115000
double currentapproxtime=q+31;                                          58120000
double lastmakeroomapproxtime=q+33,                                     58125000
       mempressinterval=q+35;                                           58130000
integer lastprocoldpri=q+37;                                   <<01840>>58135000
double lasttrans'term=q+40,                                    <<01840>>58140000
       oldfilter'term=q+42,                                    <<01840>>58145000
       term'sum=q+44;                                          <<01840>>58150000
integer swapstatus=q+46;                                       <<01987>>58155000
integer mapseg=q+47;                                           <<06104>>58160000
double lastrefswapseg = q + 49;                                <<06650>>58165000
define procimiflag=(0:1)#,                                              58170000
       procdiscioflag=(1:1)#;                                           58175000
logical tosrelstopreason = s-4;                                <<01812>>58180000
double  tosrellaststoptime = s-5;                              <<01812>>58185000
integer jcutindex = q + 51;                                    <<06650>>58190000
                                                                        58195000
    << these are parameters to help detect when powerfail >>   <<02096>>58200000
    << has occurred. this is done so we will not launch   >>   <<02096>>58205000
    << any one else until the powerfail process is done.  >>   <<02096>>58210000
                                                               <<02096>>58215000
equate   pfailpin    = % 144,      <<pfail process pin>>       <<02096>>58220000
               qi    =    %5;      <<ics initial q>>           <<02096>>58225000
                                                               <<02096>>58230000
define   pf    = abs(abs(qi)-12)#,                             <<02096>>58235000
         ppin  = abs(sysbase+pfailpin)#;                       <<02096>>58240000
                                                               <<02096>>58245000
$title " DISPATCHER : SAVESTATE"                                        58250000
subroutine savestate;                                                   58255000
                                                                        58260000
<<                                                                      58265000
subroutine savestate gets the s register value from                     58270000
the last launched process from the ics and sticks it into               58275000
the process' pcbx.                                                      58280000
it is also checked if a stack modification is required.                 58285000
if so, the stack is written to disc and the process queued on it.       58290000
>>                                                                      58295000
                                                                        58300000
begin                                                                   58305000
                                                                        58310000
<<                                                                      58315000
                                                                        58320000
update s register value firmware placed in ics                          58325000
>>                                                                      58330000
                                                                        58335000
tos:=laststkaddr;                                                       58340000
tos:=tos+sbtodbrelsdisp;                                                58345000
tos:=ics'stkdbrels;                                                     58350000
asmb(ssea);                                                             58355000
asmb(ddel);                                                             58360000
                                                                        58365000
<<save the time the process stopped in pcbx for meas intf>>    <<01812>>58370000
<<if process statistics enabled, else store 0d>>               <<01925>>58375000
tos:=laststkaddr;                                              <<01812>>58380000
tos:=tos+sbtomeasstoptime;                                     <<01812>>58385000
tos:=if gclassenabledmask.class15 then timer else 0d;          <<01925>>58390000
asmb(sdea;ddel);                                               <<01812>>58395000
if waittodispmsg.preemptedflag then                            <<04774>>58400000
   begin                                                       <<04774>>58405000
   tos:=ics(-ics'stkbankcell);                                 <<04774>>58410000
   tos:=ics(-ics'stkbasecell);                                 <<04774>>58415000
   tos:=tos+sbtomeasstopreason;                                <<04774>>58420000
   tos:=stopactive;                                            <<04774>>58425000
   asmb(ssea;ddel);                                            <<04774>>58430000
   end;                                                        <<04774>>58435000
if gclassenabledmask.class15 then                              <<01812>>58440000
   begin <<copy reason stopped from pcbx to procstat xds>>     <<01812>>58445000
   tos:=laststkaddr;                                           <<01812>>58450000
   tos:=tos+sbtomeasstopreason;                                <<01812>>58455000
   asmb(lsea);                                                 <<01812>>58460000
   tos:=measprocxdsbank;                                       <<01812>>58465000
   tos:=measprocxdsbase;                                       <<01812>>58470000
   tos := tos + (lastprocinx/pcbsize)*                         <<06650>>58475000
        class15'sub0size+cp'procquestopword;                   <<01812>>58480000
   asmb(lsea);                                                 <<01812>>58485000
   tos.stopfld:=s3;                                            <<01812>>58490000
   asmb(ssea;ddel;del;ddel); <<bank,addr,reason,bank,addr>>    <<01812>>58495000
   end;                                                        <<01812>>58500000
<<                                                                      58505000
set pcb flags of process                                                58510000
>>                                                                      58515000
                                                                        58520000
pcbpt := lastprocinx;                                          <<06650>>58525000
disable;                                                                58530000
stkinfo.stovrallflag:=0; <<clear stovrflow semaphore set in inin>>      58535000
if <> then                                                     <<01941>>58540000
   begin   <<process just had a stack overflow>>               <<01941>>58545000
   dst(ics'stkdst&lsl(2)).absentflag:=1; <<mark stk abs>>      <<01941>>58550000
   end;                                                        <<01941>>58555000
if waittodispmsg.memtrapflag then                                       58560000
   begin <<set wait on memory flags>>                                   58565000
   resabortinfo.sarflag:=1;                                             58570000
   wakemask.memorywaitflag:=1;                                          58575000
   end;                                                                 58580000
if waittodispmsg.discwaitflag then resabortinfo.pcbshortwaitflag:=1     58585000
else resabortinfo.pcbshortwaitflag:=0;                                  58590000
if waittodispmsg.transcompflag then resabortinfo.pcblongwaitflag:=1     58595000
else resabortinfo.pcblongwaitflag:=0;                                   58600000
if waittodispmsg.termreadflag then resabortinfo.pcbtermreadflag:=1      58605000
else resabortinfo.pcbtermreadflag:=0;                                   58610000
cpunum;                   << get cpu number >>                 <<04663>>58615000
if tos= series64 then update'pcbxbnds'flag;                    <<04663>>58620000
enable;                                                                 58625000
                                                                        58630000
<<add last ref swap code seg to min locality if memory pressure>>       58635000
                                                                        58640000
if not memorypressure then                                     <<06650>>58645000
   begin                                                       <<06650>>58650000
   lastrefcodeseg0 := 0;                                       <<06650>>58655000
   lastrefcodeseg1 := 0;                                       <<06650>>58660000
   end                                                         <<06650>>58665000
else                                                           <<06650>>58670000
   begin  <<add most recent swap seg to min locality>>                  58675000
   lastrefswapseg := 0d;                                       <<06650>>58680000
   tos:=ics'stkbank;                                                    58685000
   tos:=ics'absstkdb+ics'stkdbrels-4;<<last p addr>>           <<06104>>58690000
   if mapdst = 0  or                                           <<07320>>58695000
      (mapdst <> 0 land dst(mapdst & lsl(2)) > 0) then         <<07320>>58700000
      begin                                                    <<07320>>58705000
                                                               <<07320>>58710000
      do                                                       <<07320>>58715000
      begin                                                             58720000
      asmb( ldea );  << p,status >>                            <<06104>>58725000
      tos.(0:1) := s1.(1:1); << move mapflag to sign >>        <<06104>>58730000
      asmb(delb);    << get rid of p register >>               <<06660>>58735000
      asmb(dzro; cab);  << return value from mappedcsttophy>>  <<06660>>58740000
      tos:=mappedcsttophycst(*,lastprocinx);                   <<06104>>58745000
      if < then suddendeath(999);                              <<s8542>>58750000
      if s1.objidtype = objidpgmtype then                      <<06749>>58755000
         lastrefswapseg := tos                                 <<06660>>58760000
      else                                                     <<06104>>58765000
         if not logical(sl(s0*4+1)).segresidentflag then       <<06660>>58770000
            lastrefswapseg:=tos                                <<06104>>58775000
         else                                                           58780000
            begin                                                       58785000
            asmb( ddel );                                      <<06660>>58790000
            tos := tos+2;  << adr of delta q >>                <<06104>>58795000
            asmb( lsea );                                      <<06104>>58800000
            tos := tos+2;                                      <<06104>>58805000
            asmb( lsub );  << adr of delta p in prev marker >> <<06104>>58810000
            end;                                                        58815000
      end                                                               58820000
      until lastrefswapseg <> 0d;                              <<07320>>58825000
   tos := lastrefswapseg;                                      <<06650>>58830000
   lastrefcodeseg1 := tos;                                     <<06749>>58835000
   lastrefcodeseg0 := tos;                                     <<06749>>58840000
   addtolocality(sllptr,lastrefswapseg,2);  << no impede >>    <<07320>>58845000
   end;                                                        <<07320>>58850000
   asmb(ddel); << address of marker >>                         <<*8159>>58855000
   if dbxdsinfo.xdsdstfield <> 0                               <<01913>>58860000
   then addtolocality(sllptr,double(dbxdsinfo.xdsdstfield),2); <<07320>>58865000
                                            << no impede >>    <<07320>>58870000
   end;                                                                 58875000
end  <<subroutine savestate>>;                                          58880000
                                                                        58885000
                                                                        58890000
$title "DISPATCHER : RESCHEDULE"                                        58895000
subroutine reschedule;                                                  58900000
                                                                        58905000
<<                                                                      58910000
                                                                        58915000
reschedule is called by the scheduler after the state of the            58920000
last lauched process has been saved in order to account for             58925000
the cpu time used by the process, and, based on cpu time used           58930000
together with the cause of the processing blocking and its              58935000
scheduling class, to calculate the processes new priority               58940000
and merge it into the proper scheduling queue.                          58945000
                                                                        58950000
>>                                                                      58955000
                                                                        58960000
begin                                                                   58965000
tos:=laststkaddr;                                                       58970000
pcbpt := lastprocinx;                                          <<06650>>58975000
<<update cpu time used, check for job cutoff>>                          58980000
                                                                        58985000
if not procstate.systemprocflag then                                    58990000
   begin <<update proctime, check job cutoff of user procs>>            58995000
   <<update process' cumulative cpu time used cell in pcbx>>            59000000
   tos:=tos+sbtoproctimedisp;                                           59005000
   asmb(ldea;zero;rclk;dadd;sdea);                                      59010000
   <<if these's a cutoff cpu time on the job, update time               59015000
     left, and if this falls below zero, kill the job>>                 59020000
   tos:=tos+proctimetojcidisp;                                          59025000
   asmb(lsea);                                                          59030000
   jcutindex:=tos;        <<index into jcut>>                  <<06942>>59035000
   if jcutindex <> 0 then                                      <<07320>>59040000
      begin                                                             59045000
         jcutindex:=(jcutindex-1)*jcutentsize+jcutheadsize;    <<07320>>59050000
      tos:=tos+jcitojrolsdisp;                                          59055000
      asmb(lsea;rclk;ladd);                                             59060000
      if nocarry and s0 < 1000 then asmb(ssea) else                     59065000
         begin <<tack on another 1000 ms used>>                         59070000
         asmb(zero,xch);<<make a double word>>                          59075000
         tos:=jcutcpuc1;   <<get job cpu time>>                <<06942>>59080000
         tos:=jcutcpuc2;                                       <<06942>>59085000
         asmb(dadd,ddup);<<updated cumulative time used>>               59090000
         jcutcpuc2:=tos;                                       <<06942>>59095000
         jcutcpuc1:=tos;                                       <<06942>>59100000
         tos:=0;                                                        59105000
         tos:=jcutcpul;       <<job limit in mille-seconds>>   <<06942>>59110000
         tos:=1000d;                                                    59115000
         asmb(dmul;dcmp);                                               59120000
         if > then                                                      59125000
            begin <<set father's softkill pseudo-interrupt flag>>       59130000
            while procstate.ptypefield <> main                          59135000
            do pcbpt := fatherinfo;                            <<06650>>59140000
            if procstate.aliveflag                                      59145000
            then set'psif(pcbpt,softkill);                     <<06650>>59150000
            end;                                                        59155000
         tos:=0;                                                        59160000
         asmb(ssea);                                                    59165000
                                                               <<06411>>59170000
         end;                                                           59175000
      tos:=tos+frolstojcidisp;                                 <<02029>>59180000
      end;                                                              59185000
      tos:=tos+jcitosbdisp;                                             59190000
   end;                                                                 59195000
pcbpt := lastprocinx;                                          <<06650>>59200000
tos:=tos+sbtotsswapindisp;                                              59205000
                                                                        59210000
<<update time since swap-in and incore protect flag>>                   59215000
                                                                        59220000
if not queueinginfo.procresidentflag then                               59225000
   begin                                                                59230000
   asmb(lsea;rclk;ladd);                                                59235000
   if carry then s0:=-1;                                                59240000
   asmb(ssea);                                                          59245000
   end;                                                                 59250000
tos:=tos+tslswapintotslrdisp;                                           59255000
                                                                        59260000
<<update time since last transaction began and pcbxqcnt>>               59265000
                                                                        59270000
if queueinginfo.lschedflag then tos:=tos+tslrtoqcntdisp else            59275000
   begin                                                                59280000
   asmb(lsea;rclk;ladd);                                                59285000
   if carry then s0:=-1;                                                59290000
   if logical(waittodispmsg).transcompflag then                         59295000
      begin                                                             59300000
      s0:=0;                                                            59305000
      resabortinfo.usedquantumflag:=0;                                  59310000
      end                                                               59315000
   else if queueinginfo.cschedflag and ls0>currentcfilter then          59320000
      begin  <<consumed a quantum since last rescheduled>>              59325000
      quantumout:=true;                                                 59330000
      resabortinfo.usedquantumflag:=1;                                  59335000
      s0:=0;                                                            59340000
      end                                                               59345000
   else if ls0 > backgroundfilter then                                  59350000
      begin  <<batch job consumed a quantum since last rescheduled>>    59355000
      quantumout:=true;                                                 59360000
      s0:=0;                                                            59365000
      end;                                                              59370000
   asmb(ssea);                                                          59375000
   tos:=tos+tslrtotstbdisp;<<pcbx' time since transaction began>>       59380000
   asmb(lsea;rclk;ladd);                                                59385000
   if carry then s0:=-1;                                                59390000
                                                                        59395000
   <<tune c filter if transaction completed>>                           59400000
                                                                        59405000
   if resabortinfo.pcbtermreadflag then                                 59410000
      begin                                                             59415000
      lasttrans'term:=double(tos);   << transaction time >>    <<01840>>59420000
      lasttrans'term:=double(lasttrans'wt)*lasttrans'term;     <<01840>>59425000
      if overflow then tos := currentcfilter                   <<01840>>59430000
      else                                                     <<01840>>59435000
         begin  << form 2nd term >>                            <<01840>>59440000
         oldfilter'term:=                                      <<01840>>59445000
            double(oldfilter'wt)*double(currentcfilter);       <<01840>>59450000
         if overflow then tos:=currentcfilter                  <<01840>>59455000
         else                                                  <<01840>>59460000
            begin  << form sum of terms >>                     <<01840>>59465000
            term'sum:=lasttrans'term+oldfilter'term;           <<01840>>59470000
            if overflow then tos:=currentcfilter               <<01840>>59475000
            else                                               <<01840>>59480000
               begin  << form quotient >>                      <<01840>>59485000
               tos:=term'sum/double(denom);                    <<01840>>59490000
               if s1 <> 0 then                                 <<01840>>59495000
                  begin                                        <<01840>>59500000
                  ddel;   << the bad double word filter >>     <<01840>>59505000
                  tos:=currentcfilter;                         <<01840>>59510000
                  end                                          <<01840>>59515000
               else                                            <<01840>>59520000
                  << the new cfilter was computed ok >>        <<01840>>59525000
                  delb;   << make it a single word >>          <<01840>>59530000
               end << final divide >>;                         <<01840>>59535000
            end << form sum >>;                                <<01840>>59540000
         end << form 2nd term >>;                              <<01840>>59545000
      if ls0>=maxcfilter then                                           59550000
         begin <<should crash'>>                                        59555000
         asmb(del);                                                     59560000
         tos:=maxcfilter;                                               59565000
         end                                                            59570000
      else if ls0<=mincfilter then                                      59575000
         begin                                                          59580000
         asmb(del);                                                     59585000
         tos:=mincfilter;                                               59590000
         end;                                                           59595000
      currentcfilter:=tos;                                              59600000
      tos:=0; <<for new value of time since trans began>>               59605000
      end;                                                              59610000
   asmb(ssea);                                                          59615000
   tos:=tos+tstbtoqcntdisp;                                             59620000
   asmb(lsea);                                                          59625000
   if quantumout then                                          <<01880>>59630000
      begin                                                    <<01880>>59635000
      tos := tos + 1;                                          <<01880>>59640000
      if carry then s0 := -1; << hold at max, do not rollover>><<01880>>59645000
      end;                                                     <<01880>>59650000
   if logical(waittodispmsg).transcompflag then asmb(del,zero);         59655000
   lastprocnewprioffset := if 0<=s0<=127  then  s0*2           <<01880>>59660000
      else 256;                                                <<01880>>59665000
   asmb(ssea);                                                 <<01944>>59670000
   end;                                                                 59675000
asmb(ddel);                                                    <<01944>>59680000
<<calculate proc's new priority, and merge into proper queue>>          59685000
                                                                        59690000
pcbpt := lastprocinx;                                          <<06650>>59695000
if queueinginfo.lschedflag then                                         59700000
lastprocnewpri:=queueinginfo.prifield else                              59705000
   begin <<recalculate process' scheduling priority>>                   59710000
   lastprocoldpri:=queueinginfo.prifield;                               59715000
      if queueinginfo.cschedflag then                                   59720000
         begin                                                          59725000
         if resabortinfo.holdimppriflag                        <<06411>>59730000
         or resabortinfo.holdsirpriflag                        <<06411>>59735000
         then tos:=lastprocoldpri else                         <<06411>>59740000
         tos:=cschedbase+lastprocnewprioffset;                          59745000
         if s0 > worstcpri  then s0:= worstcpri;                        59750000
         lastprocnewpri:=tos;                                           59755000
         end                                                            59760000
      else                                                              59765000
         begin                                                          59770000
         if queueinginfo.dschedflag  then                               59775000
            begin                                                       59780000
            if resabortinfo.holdimppriflag                     <<06411>>59785000
            or resabortinfo.holdsirpriflag                     <<06411>>59790000
            then tos:=lastprocoldpri else                      <<06411>>59795000
            tos:=dschedbase+lastprocnewprioffset;                       59800000
            if s0 > worstdpri then s0:=worstdpri;                       59805000
            lastprocnewpri:=tos;                                        59810000
            end                                                         59815000
         else                                                           59820000
            begin                                                       59825000
            if resabortinfo.holdimppriflag                     <<06411>>59830000
            or resabortinfo.holdsirpriflag                     <<06411>>59835000
            then tos:=lastprocoldpri else                      <<06411>>59840000
            tos:=eschedbase+lastprocnewprioffset;                       59845000
            if s0 > worstepri then s0:=worstepri;                       59850000
            lastprocnewpri:=tos;                                        59855000
            end;                                                        59860000
         end;                                                           59865000
   end;                                                                 59870000
disable;                                                                59875000
queueinginfo.prifield:=lastprocnewpri;                                  59880000
if waittodispmsg.memtrapflag  lor                              <<06411>>59885000
   (resabortinfo.pcbshortwaitflag                              <<06411>>59890000
   lor wakemask=0) land (lastprocoldpri <> lastprocnewpri      <<01696>>59895000
   lor quantumout)  <<only move in queue if necessary>>        <<01696>>59900000
   then queueproc(lastprocinx,dispatchingq,endofclass);                 59905000
enable;                                                                 59910000
end;  <<subroutine reschedule>>                                         59915000
                                                                        59920000
$title "DISPATCHER : LAUNCH"                                            59925000
subroutine launch;                                                      59930000
                                                                        59935000
<<                                                                      59940000
launch is called by the cpu's dispatcher to set up the environment      59945000
on the ics for the launch of launchprocinx.                             59950000
>>                                                                      59955000
                                                                        59960000
                                                                        59965000
begin                                                                   59970000
                                                                        59975000
<<                                                                      59980000
fix up low core cells                                                   59985000
>>                                                                      59990000
                                                                        59995000
curprc := launchprocinx;                                       <<06650>>60000000
pcbpt := launchprocinx;                                        <<06650>>60005000
x := pbx;                                                      <<06650>>60010000
if <> then                                                              60015000
   begin <<fill in the st program block base>>                          60020000
   tos:=cstxblk(x);                                                     60025000
   tos:=tos+absolute(dstp);                                    <<06104>>60030000
   absolute(sysnrpgmsegs) := absolute(s0);                     <<06104>>60035000
   absolute(cstxp):=tos;                                                60040000
   end                                                         <<*8593>>60045000
else                                                           <<*8593>>60050000
   absolute(sysnrpgmsegs) := 0;                                <<*8593>>60055000
                                                                        60060000
<<                                                                      60065000
store the process' register values into the ics                         60070000
>>                                                                      60075000
                                                                        60080000
                                                               <<02016>>60085000
ics'curprocpcbpt := pcbpt;                                     <<06650>>60090000
                                                               <<01788>>60095000
<<make sure stk and xds around>>                               <<01788>>60100000
                                                               <<01788>>60105000
ics'stkdst:=stkinfo.stkdstfield;                               <<01788>>60110000
stkreldb:=dbxdsinfo.xdsdstfield; <<save :x reg prob>>          <<01788>>60115000
mapseg := mapdst;                                              <<06104>>60120000
if (stkreldb<>0 land dst(stkreldb&lsl(2))<0)                   <<01788>>60125000
lor ( mapseg<>0 land dst(mapseg&lsl(2))<0 )                    <<06104>>60130000
lor (dst(ics'stkdst&lsl(2))<0) then                            <<01788>>60135000
   begin <<stk, db xds or mapping seg absent>>                 <<06104>>60140000
   curprc := 0; <<changed our minds>>                          <<06650>>60145000
   tos:=ics'curprocpcbpt/pcbsize;                              <<06411>>60150000
   tos := double(stkreldb);                                    <<06660>>60155000
   tos:=0;                                                     <<06411>>60160000
   tos.causefullswap:=1;                                       <<06411>>60165000
   if stkreldb <> 0 then tos.fetchspecobj:=1;                  <<06411>>60170000
   flagprocabsent(*,*,*);                                      <<06411>>60175000
   asmb(del); <<return deltap for s exit>>                              60180000
   go startscanover;                                                    60185000
   end;                                                                 60190000
                                                               <<01788>>60195000
if mapdst <> 0 then                                            <<06104>>60200000
   begin                                                       <<06104>>60205000
   mapseg := mapdst;                                           <<06104>>60210000
   absolute(sysmapsegbank) := dst(mapseg&lsl(2)+2);            <<06104>>60215000
   absolute(sysmapsegadr) := dst(mapseg&lsl(2)+3);             <<06104>>60220000
   end                                                         <<06104>>60225000
else                                                           <<06104>>60230000
   begin                                                       <<06104>>60235000
   absolute(sysmapsegbank) := 0;                               <<06104>>60240000
   absolute(sysmapsegadr) := 0;                                <<06104>>60245000
   end;                                                        <<06104>>60250000
x:=ics'stkdst&lsl(2)+dstsysbaseinx; <<set x to stk desc>>      <<01788>>60255000
segdescfirminfo.referencedflag:=1;<<for clock alg>>                     60260000
tos:=segdescbank;                                                       60265000
ics'stkbank:=s0;                                                        60270000
tos:=segdescaddr;                                                       60275000
ics'stkbase:=s0;                                                        60280000
tos:=tos+sbtostkreldbdisp;                                              60285000
asmb(lsea); <<db offset from stack's base>>                             60290000
stkreldb:=s0; <<save for dl rel db calculation>>                        60295000
asmb(ddup,ladd);                                                        60300000
ics'absstkdb:=tos+stkreldbtosbdisp;                                     60305000
asmb(del);                                                              60310000
tos:=tos+stkdbtostkdldisp;                                              60315000
asmb(lsea);                                                             60320000
ics'stkdbreldl:=tos-stkreldb;                                           60325000
if > then suddendeath(680);                                    <<01644>>60330000
tos:=tos+stkdltodbrelzdisp;                                             60335000
asmb(lsea);                                                             60340000
ics'stkdbrelz:=tos;                                                     60345000
tos:=tos+dbrelztodbrelsdisp;                                            60350000
asmb(lsea);                                                             60355000
ics'stkdbrels:=tos;                                                     60360000
                                                                        60365000
<<                                                                      60370000
fix up process' marker for launch                                       60375000
>>                                                                      60380000
                                                                        60385000
asmb(del);                                                              60390000
tos:=ics'absstkdb+ics'stkdbrels;<<abs addr of s>>                       60395000
cpunum;             << get cpu number >>                       <<04663>>60400000
if tos= series64 then get'pcbxbnds'flag;                       <<04663>>60405000
<<figure out process' db value>>                                        60410000
tos:=dbxdsinfo;                                                         60415000
if < then                                                               60420000
   begin <<db at an abs location, so s0,s1 should be valid>>            60425000
   asmb(del,deca);                                                      60430000
   end                                                                  60435000
else                                                                    60440000
   begin                                                                60445000
   tos:=tos.xdsdstfield&lsl(2);                                         60450000
   if = then                                                            60455000
      begin  <<db at the stk>>                                          60460000
      asmb(del);                                                        60465000
      tos:=ics'absstkdb;                                                60470000
      asmb(ssea);                                                       60475000
      tos:=tos-1;                                                       60480000
      tos:=ics'stkbank;                                                 60485000
      asmb(ssea);                                                       60490000
      end                                                               60495000
   else                                                                 60500000
      begin <<db goes to base of an xds>>                               60505000
      x:=tos+dstsysbaseinx;                                             60510000
      if segdescfirminfo.absentflag then                                60515000
      suddendeath(619);                                        <<01788>>60520000
      cpunum;           << get cpu number >>                   <<04663>>60525000
      if tos= series64 then get'xdseg'limits;                  <<04663>>60530000
      segdescfirminfo.referencedflag:=1;                                60535000
      tos:=segdescaddr;                                                 60540000
      asmb(ssea);                                                       60545000
      tos:=tos-1;                                                       60550000
      tos:=segdescbank;                                                 60555000
      asmb(ssea);                                                       60560000
      end;                                                              60565000
   end;                                                                 60570000
if gclassenabledmask.class15 then                              <<01812>>60575000
   begin <<update reason stoptime>>                            <<01812>>60580000
   tos:=ics'stkbank;                                           <<01812>>60585000
   tos:=ics'stkbase+sbtomeasstopreason;                        <<01812>>60590000
   asmb(lsea);                                                 <<01812>>60595000
   if <> then                                                  <<01812>>60600000
      begin <<process stopped for reason intf knows about>>    <<01812>>60605000
      asmb(cab,cab); <<put bank & addr back on tos>>           <<01812>>60610000
      tos:=tos-sbtomeasstopreason+sbtomeasstoptime;            <<01812>>60615000
      asmb(ldea); <<time last stopped>>                        <<01812>>60620000
      if = then <<process stopped before stats enabled, use>>  <<01925>>60625000
         begin<<starttime of stats gathering as proc stoptime>><<01925>>60630000
         asmb(ddel); <<get rid of 0d for a stoptime>>          <<01925>>60635000
         tos:=measprocxdsbank;                                 <<01925>>60640000
         tos:=measprocxdsbase+2;<<time stats was enabled>>     <<01925>>60645000
         asmb(ldea);                                           <<01925>>60650000
         asmb(dxch;ddel); << del bank and addr>>               <<01925>>60655000
         end;                                                  <<01925>>60660000
      tos:=timer;                                              <<01812>>60665000
      asmb(dxch;dsub); <<tos ==> total time stopped>>          <<01812>>60670000
      asmb(dxch;ddel); <<del stkbank & stkbase>>               <<01812>>60675000
      <<tos now has the reason and total time stopped>>        <<01812>>60680000
      <<now add to appropiate counter in meas xds>>            <<01812>>60685000
      tos:=measprocxdsbank;                                    <<01812>>60690000
      tos:=measprocxdsbase;                                    <<01812>>60695000
      tos := tos + curprc/pcbsize *                            <<06749>>60700000
           class15'sub0size;                                   <<01812>>60705000
      tos:=tos+cp'pauseswaptime-2+tosrelstopreason*2;          <<01812>>60710000
      asmb(ldea); <<old cummlative time stopped>>              <<01812>>60715000
      tos:=tosrellaststoptime;  <<from s-5, >>                 <<01812>>60720000
      asmb(dadd;sdea); <<stuff away new time>>                 <<01812>>60725000
      asmb(ddel;ddel;del);<<reason, time stoppped,bank,addr>>  <<01812>>60730000
      end                                                      <<01812>>60735000
   else                                                        <<01812>>60740000
      asmb(ddel;del); <<bank, base, and reason>>               <<01812>>60745000
   end;                                                        <<01812>>60750000
<<unconditionaly zero out the measstopreason in the users>>    <<01812>>60755000
<<pcbx for history and syncronization when using meas intf>>   <<01812>>60760000
tos:=ics'stkbank;                                              <<01812>>60765000
tos:=ics'stkbase+sbtomeasstopreason;                           <<01812>>60770000
asmb(zero;ssea;ddel);                                          <<01812>>60775000
<<                                                                      60780000
if process has a pending pseudo-interrupt, put a marker                 60785000
onto his stk so he'll be launched into the interrupt handler            60790000
>>                                                                      60795000
disable;                                                                60800000
if procstate.sipiflagsfield <> 0 or                            <<d7738>>60805000
   (logical(procstate).stovflag land                           <<07320>>60810000
   not logical(resabortinfo).stovabortflag)                    <<07320>>60815000
    land not logical(stkinfo).insystemflag                     <<04483>>60820000
    land not logical(resabortinfo).hassirflag                  <<04483>>60825000
    land not logical(resabortinfo).critflag then               <<04483>>60830000
   begin <<process has a pending pseudo or soft interrupt>>    <<03041>>60835000
   if not resabortinfo.hassirflag and not resabortinfo.critflag         60840000
   or resabortinfo.ritbrkflag then                                      60845000
      begin <<build marker to pseudoint>>                               60850000
      piflag:=true;                                                     60855000
      resabortinfo.piovrflag:=0;                                        60860000
      <<add a marker to pseudoint>>                                     60865000
      asmb(ldea);                                                       60870000
      launchdb:=tos;                                                    60875000
      tos:=0;                                                           60880000
      asmb(ssea); <<don't care about x>>                                60885000
      tos:=tos+1;                                                       60890000
      tos:=ics'pideltap;                                                60895000
      asmb(ssea);                                                       60900000
      tos:=tos+1;                                                       60905000
      tos:=ics'pistatus;                                                60910000
      asmb(ssea);                                                       60915000
      tos:=tos+1;                                                       60920000
      tos:=4;                                                           60925000
      asmb(ssea);                                                       60930000
      tos:=tos+1;                                                       60935000
      tos:=launchdb;                                                    60940000
      asmb(sdea);                                                       60945000
      ics'stkdbrels:=ics'stkdbrels+4;                                   60950000
      end;                                                              60955000
   end;                                                                 60960000
                                                                        60965000
<<                                                                      60970000
set the process' breakpoints                                            60975000
>>                                                                      60980000
                                                                        60985000
bptinx := bptlink;                                             <<06650>>60990000
if bptinx<>0 then                                              <<mm.iv>>60995000
   begin                                                       <<mm.iv>>61000000
   << exchdb to breakpoint table  >>                           <<mm.iv>>61005000
   << table had better be present >>                           <<mm.iv>>61010000
   if not bpt'tab'locked then suddendeath (199);               <<mm.iv>>61015000
   tos := dst(bpt'dst'ind+2);                                  <<mm.iv>>61020000
   tos := dst(x+1);                                            <<mm.iv>>61025000
   asmb(xchd);                                                 <<mm.iv>>61030000
   bptinx := bpt(bptinx);          << index of 1st entry   >>  <<mm.iv>>61035000
                                                               <<mm.iv>>61040000
   while bptinx <> 0 do                                        <<mm.iv>>61045000
      begin                                                    <<mm.iv>>61050000
      << convert objident to dst inx >>                        <<06212>>61055000
      tos := 0;    << return value from convsegidtostinx >>    <<06750>>61060000
      tos := bpt(bptinx + clabeloffset);                       <<06750>>61065000
      tos := bpt(bptinx + clabeloffset + 1);                   <<06750>>61070000
      tos := convsegidtostinx(*);                              <<06750>>61075000
      x := tos;                                                <<06750>>61080000
                                                               <<06750>>61085000
      if dst(x) > 0 then                                       <<mm.iv>>61090000
         begin                     << set break point      >>  <<mm.iv>>61095000
         tos := dst(x:=x+2);       << get instr.           >>  <<mm.iv>>61100000
         tos := dst(x:=x+1);                                   <<mm.iv>>61105000
         tos := tos+bpt(bptinx+plocoffset); <<ploc of instr.>> <<06104>>61110000
         asmb(lsea);                                           <<mm.iv>>61115000
         if s0 = %36000 then                                   <<mm.iv>>61120000
            del                                                <<mm.iv>>61125000
         else                                                  <<mm.iv>>61130000
            begin                                              <<mm.iv>>61135000
            bpt(bptinx+instroffset) := tos;  << save instr.>>  <<06104>>61140000
            tos := %36000;                                     <<mm.iv>>61145000
            asmb(ssea);                                       <<<mm.iv>>61150000
            bpt(bptinx).bkpt'valid := 1;<< set validity flag>> <<06104>>61155000
            end;                                               <<mm.iv>>61160000
         ddel;                     << remove address       >>  <<mm.iv>>61165000
         end;                                                  <<mm.iv>>61170000
      bptinx := bpt(bptinx+linkoffset);     << next entry  >>  <<06104>>61175000
      end;                                                     <<mm.iv>>61180000
                                                               <<mm.iv>>61185000
   asmb(xchd); ddel;               << set db to orig state >>  <<mm.iv>>61190000
   end;                                                        <<mm.iv>>61195000
                                                               <<mm.iv>>61200000
                                                                        61205000
disable;                                                                61210000
                                                                        61215000
<<                                                                      61220000
fill in the disp, awake, and wait communication cells                   61225000
>>                                                                      61230000
                                                                        61235000
tos:=0;                                                        <<02827>>61240000
tos.curprocqueue:=queueinginfo.queuefield;                     <<02827>>61245000
tos.curprocpri:=queueinginfo.prifield;                         <<02827>>61250000
<<determine if process is preemptable by another process in>>  <<02827>>61255000
<<same queue.                                              >>  <<02827>>61260000
if resabortinfo.usedquantumflag or queueinginfo.lschedflag     <<02827>>61265000
then tos.preemptokflag:=1; <<enable preemption>>                        61270000
disptoawakemsg:=tos;                                                    61275000
waittodispmsg:=0;                                                       61280000
                                                                        61285000
if piflag then ics'pdisabledcnt:=2; <<launch pdisabled>>                61290000
penable;  <<series 33 requires>>                                        61295000
<<                                                                      61300000
zero out process clock                                                  61305000
>>                                                                      61310000
                                                                        61315000
tos:=0;                                                                 61320000
setclock;                                                               61325000
                                                                        61330000
<<                                                                      61335000
arm cpu bound protect interrupt                                         61340000
>>                                                                      61345000
                                                                        61350000
if procstate.systemprocflag then trlqtime:=-1<<no sys timeout>><<06943>>61355000
else trlqtime:=3; <<set timeout for approx 300 ms>>            <<06943>>61360000
                                                                        61365000
<<                                                                      61370000
ixit into the process                                                   61375000
>>                                                                      61380000
                                                                        61385000
asmb( ixit );                                                           61390000
end;  <<subroutine launch>>                                             61395000
                                                                        61400000
                                                                        61405000
                                                                        61410000
$page "DISPATCHER : DSP"                                                61415000
<<                                                                      61420000
microcode launch point of dispatcher-                                   61425000
external interrupts and traps are disabled,                             61430000
db is set at sysdb                                                      61435000
>>                                                                      61440000
                                                                        61445000
pdisable;<<we don't want the dispatcher to restart unless               61450000
          he has paused.  the dispatcher is explicitly in-              61455000
          formed of more urgent activity through the awaketo-           61460000
          disp communications cell. instead of having awake             61465000
          do a disp to restart the dispatcher, dispatcher               61470000
          stays pdisabled until launching or pausing, and               61475000
          checks awake's communications at convenient times             61480000
          to see if there's something more urgent to do.>>              61485000
                                                                        61490000
<<                                                                      61495000
make room on the ics for dispatcher's local variables, initialize       61500000
>>                                                                      61505000
                                                                        61510000
asmb(adds 51);  << for dispatcher local variables >>           <<06650>>61515000
                                                               <<01788>>61520000
<<figure out if there's been memory pressure lately>>          <<01788>>61525000
                                                               <<01788>>61530000
asmb(rsw);  if tos = %100000 then help;                        <<07320>>61535000
tos:=trldtime1;                                                <<06943>>61540000
tos:=trldtime2;                                                <<06943>>61545000
currentapproxtime:=tos;                                        <<01925>>61550000
tos:=hotimelastmakeroom;                                                61555000
tos:=lotimelastmakeroom;                                                61560000
lastmakeroomapproxtime:=tos;                                            61565000
tos:=0;                                                                 61570000
tos:=mempressdurext;                                                    61575000
mempressinterval:=tos;                                                  61580000
if currentapproxtime-lastmakeroomapproxtime < 0d               <<01788>>61585000
then memorypressure:=false<<clock rollover since makeroom>>    <<01788>>61590000
else if currentapproxtime-lastmakeroomapproxtime               <<01788>>61595000
< mempressinterval then memorypressure:=true <<recent makeroom><<01788>>61600000
else memorypressure:=false;                                    <<01788>>61605000
if cache'dst<>0 and nbanks >= 15                               <<06411>>61610000
then memorypressure:=false;<<go cheap if caching enabled>>     <<06411>>61615000
                                                                        61620000
mempressure'cell := memorypressure;                            <<*7766>>61625000
asmb(dzro,dzro);                                                        61630000
lastprocnewprioffset:=tos;                                              61635000
dontdeallocate:=tos;                                                    61640000
piflag:=tos;                                                            61645000
quantumout:=tos;                                                        61650000
<<************************************>>                       <<06212>>61655000
                                                               <<06212>>61660000
<<************************************>>                       <<06212>>61665000
                                                               <<06212>>61670000
<<                                                                      61675000
inform system that dispatcher is running,not paused                     61680000
>>                                                                      61685000
                                                                        61690000
tos:=absolute(cpcb);                                                    61695000
comment : setup for call to mmstat ( done here to preserve     <<04485>>61700000
 the pin of the last running process;                          <<04485>>61705000
                                                               <<04485>>61710000
asmb(test);                                                    <<04485>>61715000
if <> then                                                     <<04485>>61720000
   begin                                                       <<04485>>61725000
   pcbpt := (curprc);                                          <<06650>>61730000
   mmstat'(mmstatquiesce,resabortinfo,wakemask,queueinginfo,   <<06948>>61735000
          0,0,0);                                              <<06948>>61740000
   end;                                                        <<04485>>61745000
                                                                        61750000
asmb(zero,dzro);                                                        61755000
tos.disprunningflag:=1;                                                 61760000
disptoawakemsg:=tos; <<==>dispatcher running,not paused>>               61765000
curprc := tos;                                                 <<06650>>61770000
trlqtime:=tos; <<set qtime to 0-don't want clock interrupting>><<06943>>61775000
enable;                                                                 61780000
                                                                        61785000
                                                                        61790000
<<                                                                      61795000
who was running last?                                                   61800000
>>                                                                      61805000
                                                                        61810000
asmb(test);                                                             61815000
if <> then                                                              61820000
   begin <<a process was running>>                                      61825000
   if s0=-1 then                                                        61830000
      begin  <<system just coming up>>                                  61835000
      asmb(del);                                                        61840000
      lastprocinx := 0;                                        <<06650>>61845000
      initio(2); <<initialize system disc>>                             61850000
      startclock(0,0d); <<get clock moving>>                   <<01770>>61855000
      end                                                               61860000
   else                                                                 61865000
      begin                                                             61870000
      lastprocinx := tos;                                      <<06650>>61875000
      laststksysbaseinx:=ics'stkdst&lsl(2)+dstsysbaseinx;               61880000
      if gclassenabledmask.class0 then                                  61885000
         begin  <<measure process burst event and duration>>            61890000
         tos:=measstatxdsbank;                                          61895000
         tos:=measstatxdsbase;                                          61900000
         tos:=tos+c0sub0'segreloff+c'launch;                   <<ray.v>>61905000
         asmb(lsea);                                                    61910000
         tos:=tos+1;                                                    61915000
         asmb(ssea);  << cum # of launches>>                            61920000
         tos:=tos-c'launch+c'cpuprocess;                       <<ray.v>>61925000
         asmb(ldea);                                                    61930000
         asmb(zero;rclk);                                               61935000
         asmb(dadd);                                                    61940000
         asmb(sdea;ddel); <<cum cpu time on processes>>                 61945000
         end;                                                           61950000
      if gclassenabledmask.class15 then                        <<01812>>61955000
         begin <<cpu time & number of launches>>               <<01812>>61960000
         tos:=measprocxdsbank;                                 <<01812>>61965000
         tos:=measprocxdsbase;                                 <<01812>>61970000
         tos:=tos+(lastprocinx/pcbsize)*                       <<06650>>61975000
              class15'sub0size+cp'launch;                      <<01812>>61980000
         asmb(lsea);                                           <<01812>>61985000
         tos:=tos+1;                                           <<01812>>61990000
         asmb(ssea);                                           <<01812>>61995000
         tos:=tos-cp'launch+cp'cputime;                        <<01812>>62000000
         asmb(ldea);                                           <<01812>>62005000
         asmb(zero;rclk);                                      <<01812>>62010000
         asmb(dadd;sdea;ddel);                                 <<01812>>62015000
         end;                                                  <<01812>>62020000
      end;                                                              62025000
   end                                                                  62030000
else                                                                    62035000
   begin <<system was paused>>                                          62040000
   lastprocinx:=tos;                                                    62045000
   if gclassenabledmask.class0 then                                     62050000
      begin  <<measurement enabled for this statistics class>>          62055000
      tos:=measstatxdsbank;                                             62060000
      tos:=measstatxdsbase;                                             62065000
      tos:=tos+c0sub0'segreloff;                                        62070000
      if liststate.procimiflag and liststate.procdiscioflag             62075000
      then tos:=tos+c'pausebothtime <<pause mm and user io>>   <<ray.v>>62080000
      else if liststate.procimiflag then                       <<ray.v>>62085000
           tos:=tos+c'pausesegswaptime                         <<06411>>62090000
      else if liststate.procdiscioflag  then                   <<ray.v>>62095000
           tos:=tos+c'pausedisctime                            <<ray.v>>62100000
      else tos:=tos+c'pauseidletime;                           <<ray.v>>62105000
      asmb(ldea);                                                       62110000
      tos:=timer-savepausetime;                                         62115000
      asmb(dadd;sdea;ddel);  <<why are we pausing>>                     62120000
      end;                                                              62125000
                                                                        62130000
   end;                                                                 62135000
                                                                        62140000
<<                                                                      62145000
if a process was running, log its quiesce, save its register            62150000
states, reschedule it, account for and update resource usage            62155000
>>                                                                      62160000
                                                                        62165000
pcbpt := lastprocinx;                                          <<06650>>62170000
if <> then   <<if = then dispatcher had been paused>>                   62175000
   begin                                                                62180000
   tos:=ics'stkbank;                                                    62185000
   tos:=ics'stkbase;                                                    62190000
   laststkaddr:=tos;                                                    62195000
   savestate;                                                           62200000
   if not procstate.systemprocflag then reschedule else        <<01913>>62205000
      begin <<update cpu time used for system processes>>      <<01913>>62210000
      tos:=laststkaddr;                                        <<01913>>62215000
      tos:=tos+sbtoproctimedisp;                               <<01913>>62220000
      asmb(ldea;zero;rclk;dadd;sdea;ddel);                     <<01913>>62225000
      end;                                                     <<01913>>62230000
   end;                                                                 62235000
                                                                        62240000
<<                                                                      62245000
devote the cpu to the most urgent pending activity                      62250000
>>                                                                      62255000
                                                                        62260000
startscanover:                                                          62265000
                                                                        62270000
enable;                                                                 62275000
liststate:=moreurgentswcnt:=0;                                          62280000
swapdelay:=false;                                                       62285000
swapfence:=worstpri;                                                    62290000
curractpri:=0; <<most urgent>>                                          62295000
                                                               <<01679>>62300000
<<check for scheduler messages>>                               <<01679>>62305000
                                                               <<01679>>62310000
check'disp'portstatus;                                         <<*7565>>62315000
if <> then                                                     <<*7565>>62320000
begin                                                          <<01679>>62325000
processschedmsgs; <<process msgs from ics monitors>>                    62330000
if <> then                                                     <<01557>>62335000
   begin  <<couldn't fit in a seg for the i/o system>>         <<01557>>62340000
   swapdelay:=true;  <<set clock to check later>>              <<01557>>62345000
   swapfence:=0;  <<don't schedule memory for any processes>>  <<01557>>62350000
   end;                                                        <<01557>>62355000
end;                                                           <<01679>>62360000
                                                                        62365000
<<                                                                      62370000
scan the dispq, work on most urgent process ready or requiring attention62375000
>>                                                                      62380000
                                                                        62385000
disable;                                                                62390000
awaketoschedmsg:=worstpri;                                              62395000
candprocinx:=dispqhead;                                        <<01987>>62400000
while candprocinx <> 0 do                                      <<01987>>62405000
   begin <<launch or swap-in the process>>                              62410000
   candpin := candprocinx/pcbsize;                             <<06650>>62415000
   if pf <> 0 then       <<powerfail recovery in progress>>    <<02096>>62420000
       if candpin <> (ppin/pcbsize) then  <<not pfail pin>>    <<02096>>62425000
          go to pfail;                                         <<02096>>62430000
                                                               <<02096>>62435000
   pcbpt :=  candprocinx;                                      <<06650>>62440000
   tos:=procstate.piflagsfield;                                         62445000
   if = then asmb(del) else                                             62450000
      begin <<pending pseudo interrupt>>                                62455000
      tos:=tos&lsl(9);                                                  62460000
      asmb(scan 0;del);                                                 62465000
      if x <> 4 and x <> 3 then pcbpt:=candprocinx else        <<06650>>62470000
         begin << 3==>stop,4==> hyb >>                                  62475000
         pcbpt:=candprocinx;                                   <<06650>>62480000
         if not resabortinfo.critflag                                   62485000
         and not resabortinfo.hassirflag then                           62490000
            begin <<throw him out>>                                     62495000
            queueproc(candprocinx,noqueue,noinfo);                      62500000
            go startscanover;                                           62505000
            end;                                                        62510000
         end;                                                           62515000
      end;                                                              62520000
   if not resabortinfo.pcbshortwaitflag and wakemask.(0:15)<>0 then     62525000
      begin                                                             62530000
      queueproc(pcbpt,noqueue,noinfo);                         <<06650>>62535000
      go startscanover;                                                 62540000
      end;                                                              62545000
   if wakemask=0 then                                                   62550000
      begin  <<process is launchable>>                                  62555000
      launchprocinx := pcbpt;                                  <<06650>>62560000
      enable;                                                           62565000
      launch; <<no return>>                                             62570000
      end                                                               62575000
   else                                                                 62580000
      begin <<process not launchable>>                                  62585000
      if not resabortinfo.sarflag then                                  62590000
         begin  <<soon launchable-disc i/o or segs on way in>>          62595000
         if wakemask.memorywakeflag then liststate.procimiflag:=1       62600000
         else liststate.procdiscioflag:=1;                              62605000
         moreurgentswcnt:=moreurgentswcnt+1;                            62610000
         if memorypressure then                                         62615000
            begin                                                       62620000
            tos := pcbpt;                                      <<06650>>62625000
            tos:=0d;                                                    62630000
            tos:=0d;                                           <<06660>>62635000
            asmb(tsbc refminlocbit);                                    62640000
            adjustlocality(*,*,*,*);                                    62645000
            end;                                                        62650000
         candprocinx:=nqptr;  <<next process to consider>>     <<01987>>62655000
         end                                                            62660000
      else                                                              62665000
         begin  <<process needs some main memory scheduling>>           62670000
         if(memorypressure land moreurgentswcnt>=staticmplfence<<01913>>62675000
         land staticmplfence > 0)                              <<01987>>62680000
         lor (integer(queueinginfo).prifield >= swapfence) then<<01913>>62685000
            begin <<no room for this process>>                          62690000
            candprocinx:=nqptr;<<next proc to consider>>       <<01987>>62695000
            end                                                         62700000
         else                                                           62705000
            begin <<process requires some segments>>                    62710000
            swapinprocinx := pcbpt;                            <<06650>>62715000
            curractpri:=queueinginfo.prifield;                          62720000
            enable;                                                     62725000
            tos := 0;       << return value from swapin >>     <<06752>>62730000
            tos:=swapinprocinx;                                <<06411>>62735000
            tos:=0;                                            <<06411>>62740000
            tos.swapwakeup:=1;                                 <<06411>>62745000
            tos.swaphardrequest:=0;                            <<06411>>62750000
            tos := swapin(*,*);                                <<06752>>62755000
            swapstatus := tos;                                 <<06752>>62760000
            if swapstatus=mmok then                            <<01987>>62765000
               begin  <<successful swap-in>>                            62770000
               if curractpri >= awaketoschedmsg then           <<03766>>62775000
                  go startscanover;                            <<03766>>62780000
               moreurgentswcnt:=moreurgentswcnt+1; <<on its way in>>    62785000
               disable; <<q link integrity>>                            62790000
               candprocinx:=nqptr;<<next  to consider>>        <<01987>>62795000
               end                                                      62800000
            else                                                        62805000
               begin <<swapin incomplete>>                              62810000
               if swapstatus=mmioerr then                      <<01987>>62815000
                  begin <<disc i/o error-abort the process>>            62820000
                  pcbpt := swapinprocinx;                      <<06650>>62825000
                  abortprocess(swapinprocinx,makepresioerr);            62830000
                  go startscanover;                                     62835000
                  end                                                   62840000
               else                                                     62845000
                  begin                                                 62850000
                  if awaketoschedmsg < curractpri or           <<06411>>62855000
                  swapstatus = mmpreempt then                  <<06411>>62860000
                     begin <<more urgent pending activity>>             62865000
                     if gclassenabledmask.class0 then                   62870000
                        begin  <<measure giveup>>                       62875000
                        tos:=measstatxdsbank;                           62880000
                        tos:=measstatxdsbase;                           62885000
                        tos:=tos+c0sub0'segreloff+c'giveup;    <<ray.v>>62890000
                        asmb(lsea;inca;ssea;ddel);                      62895000
                        end;                                            62900000
                     go startscanover;                                  62905000
                     end                                                62910000
                  else                                                  62915000
                     begin  <<no room or delay>>                        62920000
                     swapdelay:=true;                                   62925000
                     if swapstatus<>mmsegbusy                  <<01987>>62930000
                     then swapfence:=queueinginfo.prifield;    <<01987>>62935000
                     if moreurgentswcnt <> 0                   <<01987>>62940000
                     or swapstatus = mmsegbusy then            <<01987>>62945000
                        begin <<continue on>>                  <<01987>>62950000
                        if gclassenabledmask.class0 then       <<02007>>62955000
                           begin                               <<02007>>62960000
                           if swapstatus=mmthrashdanger then   <<02007>>62965000
                              begin  <<meas swapin deferral>>  <<02007>>62970000
                              tos:=measstatxdsbank;            <<02007>>62975000
                              tos:=measstatxdsbase;            <<02007>>62980000
                              tos:=tos+c0sub0'segreloff+       <<02007>>62985000
                                   c'deferral;                 <<02007>>62990000
                              asmb(lsea);                      <<02007>>62995000
                              tos:=tos+1;                      <<02007>>63000000
                              asmb(ssea;ddel);                 <<02007>>63005000
                              end;                             <<02007>>63010000
                           end;                                <<02007>>63015000
                        disable;                                        63020000
                        pcbpt := candprocinx;                  <<06650>>63025000
                        candprocinx:=nqptr;                    <<01987>>63030000
                        end                                             63035000
                     else                                               63040000
                        begin <<have to make space-noone else will run>>63045000
                        swapstatus:=swapin(swapinprocinx,hardswap);     63050000
                        if swapstatus=mmok                     <<01987>>63055000
                        or awaketoschedmsg < curractpri then   <<01987>>63060000
                           begin                               <<ray.v>>63065000
                           if swapstatus=mmok then             <<01987>>63070000
                              begin                            <<ray.v>>63075000
                              if gclassenabledmask.class0 then <<ray.v>>63080000
                                 begin                         <<ray.v>>63085000
                                 tos:=measstatxdsbank;         <<ray.v>>63090000
                                 tos:=measstatxdsbase;         <<ray.v>>63095000
                                 tos:=tos+c0sub0'segreloff;    <<ray.v>>63100000
                                 tos:=tos+c'hardrequest;       <<ray.v>>63105000
                                 asmb(lsea);                   <<ray.v>>63110000
                                 tos:=tos+1;                   <<ray.v>>63115000
                                 asmb(ssea;ddel);              <<ray.v>>63120000
                                 end;                          <<ray.v>>63125000
                              end                              <<02007>>63130000
                           else                                <<02007>>63135000
                              if gclassenabledmask.class0 then <<02007>>63140000
                                 begin <<measure swapin giveup><<02007>>63145000
                                 tos:=measstatxdsbank;         <<02007>>63150000
                                 tos:=measstatxdsbase;         <<02007>>63155000
                                 tos:=tos+c0sub0'segreloff+    <<02007>>63160000
                                      c'giveup;                <<02007>>63165000
                                 asmb(lsea);                   <<02007>>63170000
                                 tos:=tos+1;                   <<02007>>63175000
                                 asmb(ssea;ddel);              <<02007>>63180000
                                 end;                          <<02007>>63185000
                           go startscanover;                            63190000
                           end                                          63195000
                        else                                   <<ray.v>>63200000
                           begin                               <<ray.v>>63205000
                           candprocinx:=0;                     <<01987>>63210000
                           swapdelay:=true;                    <<ray.v>>63215000
                           end;                                <<ray.v>>63220000
                        end;                                            63225000
                     end;                                               63230000
                  end;                                                  63235000
               end;                                                     63240000
            end;                                                        63245000
         end;                                                           63250000
      end;                                                              63255000
   end;                                                                 63260000
                                                                        63265000
                                                                        63270000
<<                                                                      63275000
nobody to launch or swap-in, so fix up memory until a process           63280000
becomes active or swap delay expires                                    63285000
>>                                                                      63290000
                                                                        63295000
curractpri:=worstpri;                                                   63300000
enable;                                                                 63305000
if logical(garbcollenabled) and memorypressure then collectgarbage(0d); 63310000
disable;                                                                63315000
                                                               <<02096>>63320000
pfail:       <<only swap in and launch powerfail process>>     <<02096>>63325000
             <<do not launch any one else>>                    <<02096>>63330000
                                                               <<02096>>63335000
if awaketoschedmsg < curractpri then go startscanover else     <<03766>>63340000
   begin  <<nothing worthwhile to do, so pause>>                        63345000
   if swapdelay then trlqtime:=1; <<alarm clock>>              <<06943>>63350000
   tos:=0;                                                              63355000
   tos.disprunningflag:=1;                                              63360000
   tos.pausedflag:=1;                                                   63365000
   disptoawakemsg:=tos;                                                 63370000
   penable;  <<will cause dispatcher to start over after next disp>>    63375000
                                                                        63380000
   if gclassenabledmask.class0 then                                     63385000
      begin  <<measurement enabled for this statistics class>>          63390000
      savepausetime:=timer;                                             63395000
      tos:=measstatxdsbank;                                             63400000
      tos:=measstatxdsbase;                                             63405000
      tos:=tos+c0sub0'segreloff;                                        63410000
      if dispqhead=0 then tos:=tos+c'pauseidlecnt              <<ray.v>>63415000
      else if liststate.procimiflag and liststate.procdiscioflag        63420000
      then tos:=tos+c'pausebothcnt                             <<ray.v>>63425000
      else if liststate.procimiflag then                       <<ray.v>>63430000
           tos:=tos+c'pausesegswapcnt                          <<06411>>63435000
      else if liststate.procdiscioflag then                    <<ray.v>>63440000
           tos:=tos+c'pausedisccnt;                            <<ray.v>>63445000
      asmb(lsea);                                                       63450000
      tos:=tos+1;                                                       63455000
      asmb(ssea;ddel);  <<why are we pausing>>                          63460000
      end;                                                              63465000
                                                                        63470000
   enable;                                                              63475000
                                                               <<02091>>63480000
pauseloop:                                                     <<02091>>63485000
if ics(-ics'pdiscntcell) <> 0 then                             <<02091>>63490000
   comment:  the purpose of the following code is to cover up  <<k7563>>63495000
             a pdisable problem in which an interrupt handler  <<k7563>>63500000
             appears to execute a pdisable without a           <<k7563>>63505000
             corresponding penable.  this strange problem      <<k7563>>63510000
             always appears to leave the pdisable count at 1.  <<k7563>>63515000
             if this condition is met, we shall execute a      <<k7563>>63520000
             penable on behalf of the defective software       <<k7563>>63525000
             [a small prayer is in order here] and continue    <<k7563>>63530000
             execution (soft'death will log this event). ;     <<k7563>>63535000
                                                               <<k7563>>63540000
   if ics(-ics'pdiscntcell) = 1 then                           <<k7563>>63545000
      begin                                                    <<k7563>>63550000
      penable;  <<it's a miracle>>                             <<k7563>>63555000
      soft'death(634);                                         <<k7563>>63560000
      end                                                      <<k7563>>63565000
   else                                                        <<k7563>>63570000
      suddendeath(634);     <<leave the sf hook in>>           <<k7563>>63575000
                                                               <<*7565>>63580000
<< the following code has been inserted to catch a pending   >><<*7565>>63585000
<< dispatcher message (usually a cache move request) that we >><<*7565>>63590000
<< never see. this problem began with the newly rewritten    >><<*7565>>63595000
<< message facility. if the reason for the pending message is>><<*7565>>63600000
<< ever fixed, this code should be removed.                  >><<*7565>>63605000
                                                               <<*7565>>63610000
   check'disp'portstatus;                                      <<*7565>>63615000
   if <> or awaketoschedmsg < curractpri then                  <<*7565>>63620000
      begin                                                    <<*7565>>63625000
      disable;                                                 <<*7565>>63630000
      pdisable;                                                <<*7565>>63635000
      disptoawakemsg.pausedflag := 0;                          <<*7565>>63640000
      go startscanover;                                        <<*7565>>63645000
      end                                                      <<*7565>>63650000
   else                                                        <<*7565>>63655000
   assemble(paus);                                             <<02091>>63660000
   go to pauseloop;                                            <<02091>>63665000
                                                               <<02091>>63670000
   help;                                                                63675000
   end;                                                                 63680000
end  <<dsp>>;                                                           63685000
                                                                        63690000
                                                                        63695000
$control segment=main                                                   63700000
end  <<kernelc>>.                                                       63705000
