$CONTROL MAP,CODE,USLINIT,LINES=120                                     00005000
$control map,code,uslinit                                               00010000
<<kerneld - module 93>>                                        <<01636>>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
begin                                                                   00055000
<<the following equates whose identifier end with the>>                 00060000
<<character "N" or "B" are the sysglob-relative address>>               00065000
<<of the identifiers>>                                                  00070000
$thirty                                                                 00075000
$control main=kerneld                                                   00080000
$control segment=kerneld                                                00085000
$include inclpcb5                                              <<06651>>00090000
equate   cstb      =1,                                                  00095000
         dstb      =2,                                                  00100000
         pcbb      =3,                                                  00105000
         qi        =5,                                                  00110000
         icsix=7,                                              <<01636>>00115000
         lpdtn     =%10,                                                00120000
         dfcn      =%32,                                                00125000
         dfsn      =%33,                                                00130000
         nbanksn   =%47,                                                00135000
         cstblkn   =%51,                                                00140000
         pressn    =%53,                                                00145000
         maxdsegn  =%111,                                               00150000
         dfc'      =dfcn+%1000,                                         00155000
         dfs'      =dfsn+%1000,                                         00160000
         maxdseg'  =maxdsegn+%1000,                                     00165000
         ccg       =0,                                                  00170000
         ccl       =1,                                                  00175000
         cce       =2,                                                  00180000
         stack'limit =31223,                                            00185000
         lastn     =0;                                                  00190000
                                                               <<03044>>00195000
define  abs      = absolute#;                                  <<03044>>00200000
                                                               <<03044>>00205000
integer pointer                                                         00210000
         dsti      =db+dstb,           <<dst table>>                    00215000
         dsti'     =dstb,                                               00220000
         pcbi      =db+pcbb,                                   <<06651>>00225000
         pcbi'     =pcbb,                                      <<06651>>00230000
         pcb       =pcbb,                                      <<06651>>00235000
         ics=icsix,                                            <<01636>>00240000
         csti      =db+cstb,           <<cst table>>                    00245000
         csti'     =cstb,                                               00250000
         cstblk    =db+cstblkn,                                         00255000
         cstblk'   =cstblkn,                                            00260000
         lpdt      =db+lpdtn;                                           00265000
logical pointer                                                         00270000
         pcbl'     =pcbb,                                      <<06651>>00275000
         dstl      =db+dstb,           <<dst table>>                    00280000
         dstl'     =dstb;                                               00285000
logical  status    =q-1;                                                00290000
array q0array(*)=q+0;                                          <<03044>>00295000
integer  dfcx      =db+dfcn,           <<@cst-@dst>>                    00300000
         dfsx      =db+dfsn;                                            00305000
                                                                        00310000
equate dstix=2,                                                         00315000
       vdsmtabix=%26,                                                   00320000
       sysvdsmtab=%1026;                                                00325000
                                                                        00330000
<<table pointers for lst access>>                                       00335000
                                                                        00340000
integer pointer dst=dstix;                                              00345000
logical pointer vdsmtab=vdsmtabix;                                      00350000
                                                                        00355000
logical ls0=s-0,                                                        00360000
        ls1=s-1;                                                        00365000
integer s0=s-0;                                                         00370000
equate pxmaxstack=23;                                          <<01636>>00375000
                                                               <<03044>>00380000
<<soft interrupt equates>>                                     <<03044>>00385000
                                                               <<03044>>00390000
equate   usermsgport     = 1,                                  <<03044>>00395000
         systemsgport    = 2,                                  <<03044>>00400000
         deletemsg       = 0;                                  <<03044>>00405000
                                                               <<03044>>00410000
$include inclvmld                                                       00415000
integer  x         =x;                 <<the x-register>>               00420000
define   f         =absolute#,                                          00425000
         asmb      =assemble#,                                          00430000
         forcestko =asmb(adds 100;subs 100)#,                           00435000
         duplicate =asmb(dup)#,                                         00440000
         triplicate=asmb(dup,dup)#,                                     00445000
         exchange  =asmb(xch)#,                                         00450000
         pdisable  =asmb(psdb)#,                                        00455000
         penable   =asmb(pseb)#,                                        00460000
         disable   =asmb(sed 0)#,                                       00465000
         enable    =asmb(sed 1)#,                                       00470000
         trapsoff  =push(status);tos.(2:1) := 0; set(status)#,          00475000
         psm1      =integer(vmpagesize-1)#,                             00480000
         sector    =(vmpagesize/128)#,                                  00485000
         lmem      =asmb(lsea)#,                                        00490000
         smem      =asmb(ssea)#,                                        00495000
         lmemd     =asmb(ldea)#,                                        00500000
         smemd     =asmb(sdea)#,                                        00505000
         mfdseg    =asmb(mfds 4)#,                                      00510000
         mtdseg    =asmb(mtds 4)#,                                      00515000
         ccfld     =( 6: 2)#,                                           00520000
         abit      =( 0: 1)#,          <<absence bit>>                  00525000
         rbit      =( 2: 1)#,          <<reference bit>>                00530000
         dsfld     =( 3:13)#,          <<data seg size field>>          00535000
         csfld     =( 4:12)#,          <<code seg size field>>          00540000
         privf     =( 0: 1)#,          <<priv mode bit>>                00545000
         sharf     =( 1: 1)#,          <<shared seg bit>>               00550000
         dsegf     =( 2:14)#,          <<dseg field>>          <<07322>>00555000
         npfld     =(8:8)#,  <<# vm pages allocated>>                   00560000
         dfc       =f(dfc')#,                                           00565000
         dfs       =f(dfs')#,                                           00570000
         ics'global'z = f(f(qi)-8)#,                                    00575000
         wsize     =( 8: 8)#;                                           00580000
                                                                        00585000
array qarray(*) = q+0;                                         <<*7767>>00590000
$include inclpxdl                                              <<*7767>>00595000
$include inclpxft                                              <<*7767>>00600000
$include inclmeas                                                       00605000
                                                                        00610000
$include inclmift                                              <<04110>>00615000
<<ics globals>>                                                         00620000
                                                                        00625000
equate icscurractpricell=20,                                            00630000
       icspdisablecntcell=18,                                           00635000
       icsstkdstcell=16,                                                00640000
       icsstkbankcell=5,                                                00645000
       icsstkbasecell=9,                                       <<01813>>00650000
       icsstkdbcell=4;                                                  00655000
                                                                        00660000
<<standard system tables entry allocation  >>                           00665000
                                                                        00670000
integer array systabentry00(*)=db+0,                                    00675000
              systabentry01(*)=db+1,                                    00680000
              systabentry02(*)=db+2,                                    00685000
              systabentry03(*)=db+3,                                    00690000
              systabentry04(*)=db+4;                                    00695000
                                                                        00700000
define entryword00=systabentry00(x)#,                                   00705000
       entryword01=systabentry01(x)#,                                   00710000
       entryword02=systabentry02(x)#,                                   00715000
       entryword03=systabentry03(x)#,                                   00720000
       entryword04=systabentry04(x)#;                                   00725000
                                                                        00730000
integer array systabfreecount(*)=db+2,                                  00735000
              systabconfcount(*)=db+0,                                  00740000
              systabfreehead(*)=db+3,                                   00745000
              systabsize(*)=db+1,                                       00750000
              systabfreeword(*)=db+0,                                   00755000
              systabnext(*)=db+1;                                       00760000
                                                                        00765000
define systabfreecnt=systabfreecount(x)#,                               00770000
       systabentrysize=systabsize(x)#,                                  00775000
       systabentrycount=systabconfcount(x)#,                            00780000
       systabfirstfreeinx=systabfreehead(x)#,                           00785000
       systabfreeindicator=systabfreeword(x)#,                          00790000
       systabentrynextinx=systabnext(x)#;                               00795000
                                                                        00800000
$include inclst                                                         00805000
                                                                        00810000
$include inclobj                                               <<06239>>00815000
                                                                        00820000
                                                                        00825000
                                                                        00830000
$include inclmsg                                                        00835000
                                                                        00840000
                                                               <<04662>>00845000
<< the following defines are used to support privileged    >>  <<04662>>00850000
<< mode bounds checking. get'xdseg'limits transfers the    >>  <<04662>>00855000
<< bank, base address, and limit address to ics qi minus   >>  <<04662>>00860000
<< area. the index register is expected to be pointing to  >>  <<04662>>00865000
<< dst entry, word 0.                                      >>  <<04662>>00870000
                                                               <<04662>>00875000
define  get'xdseg'limits=                                      <<04662>>00880000
                                                               <<04662>>00885000
  begin                                                        <<04662>>00890000
  tos:= x;                    << save index reg >>             <<04662>>00895000
  tos:= dst(x:= x+2);         << get xdseg bank num >>         <<04662>>00900000
  tos:= dst(x:= x+1);         << get xdseg base addr >>        <<04662>>00905000
  asmb(dup);                  << copy xdseg base addr >>       <<04662>>00910000
  tos:= (dst(x:= x-3).(3:13) & lsl(2)) + tos;                  <<04662>>00915000
  ics(- ics'xdseglimcell):= tos;    << ics gets xdseg limt >>  <<04662>>00920000
  ics(- ics'xdsegbasecell):= tos;   << ics gets xdseg base >>  <<04662>>00925000
  ics(- ics'xdsegbnkcell):= tos;    << ics gets xdseg bank >>  <<04662>>00930000
  x:= tos;                          << restore index reg. >>   <<04662>>00935000
  end#;                                                        <<04662>>00940000
                                                               <<04662>>00945000
define xfer'xdseg'limits=                                      <<04662>>00950000
                                                               <<04662>>00955000
  tos:= 2;                                                     <<04662>>00960000
  asmb(sbl)#;                                                  <<04662>>00965000
                                                               <<04662>>00970000
define   cpunum= asmb(pcn)#,         << get cpu number >>      <<04662>>00975000
         sbl   = con %20104, %12#;                             <<04662>>00980000
                                                               <<04662>>00985000
equate series64    = 4,                                        <<04662>>00990000
       ics'xdseglimcell = 25,                                  <<06636>>00995000
       ics'xdsegbasecell  = 26,                                <<06636>>01000000
       ics'xdsegbnkcell  = 27;                                 <<06636>>01005000
$include inclpcbx                                              <<06670>>01010000
                                                               <<03044>>01015000
                                                                        01020000
                                                                        01025000
$include inclmmst                                              <<06953>>01030000
$include inclreg                                               <<06239>>01035000
equate                                                         <<06239>>01040000
       pagepower=7,                                            <<06239>>01045000
       sirtabentrylength=2,                                             01050000
       cstxbmwrdcnt=4,                                                  01055000
       blocked=1,                                              <<01558>>01060000
       zerofill=5;                                             <<01558>>01065000
                                                                        01070000
<<scheduler message port assignments>>                                  01075000
                                                                        01080000
equate sysbase=%1000;                                                   01085000
equate memorywaitcode=%10000,                                           01090000
       memtrap=%4000;                                                   01095000
                                                                        01100000
define logicalmapping = absolute (%1220)#,                     <<06283>>01105000
       total'phy'cst'num = absolute (%1224)#;                  <<06283>>01110000
procedure abort(p1,p2,p3);                                              01115000
   value      p1,p2,p3;                                                 01120000
   integer    p1,p2,p3;                                                 01125000
   option     external;                                                 01130000
procedure erroron;                                                      01135000
   option     external;                                                 01140000
procedure errorexit(enum,n1,n2);                                        01145000
   value      enum,n1,n2;                                               01150000
   integer    enum,n1,n2;                                               01155000
   option     external;                                                 01160000
double procedure chek(int,fl,parm,capm,ovm);                            01165000
   value      int,fl,parm,capm,ovm;                                     01170000
   logical    int,fl,ovm;                                               01175000
   double     parm,capm;                                                01180000
   option     external,variable;                                        01185000
procedure awakeio(dit,mask);                                            01190000
   value      dit,mask;                                                 01195000
   integer    pointer dit;                                              01200000
   integer    mask;                                                     01205000
   option     external;                                                 01210000
procedure hang(intrinexit,codeclass,param);                             01215000
   value      intrinexit,codeclass,param;                               01220000
   integer    intrinexit,codeclass,param;                               01225000
   option     external;                                                 01230000
integer procedure xjdt(func,id,dstx);                                   01235000
   value      func,id,dstx;                                             01240000
   integer    func,id,dstx;                                             01245000
   option     external;                                                 01250000
procedure help;                                                         01255000
   option     external;                                                 01260000
procedure requcop(x,y,z);                                               01265000
   value      x,y,z;                                                    01270000
   integer    x,y,z;                                                    01275000
   option     external;                                                 01280000
procedure suddendeath(enum);                                            01285000
   value      enum;                                                     01290000
   integer    enum;                                                     01295000
   option     external;                                                 01300000
                                                               <<k7569>>01305000
procedure soft'death(enum);                                    <<k7569>>01310000
   value enum;                                                 <<k7569>>01315000
   integer enum;                                               <<k7569>>01320000
   option external;                                            <<k7569>>01325000
                                                                        01330000
double procedure attachio(ldev,qmisc,dstx,adr,fnct,cnt,p1,p2,  <<01558>>01335000
  flags);                                                      <<01558>>01340000
value ldev,qmisc,dstx,adr,fnct,cnt,p1,p2,flags;                <<01558>>01345000
integer ldev,qmisc,dstx,adr,fnct,cnt,p1,p2,flags;              <<01558>>01350000
option external;                                               <<01558>>01355000
                                                                        01360000
                                                               <<03044>>01365000
procedure aborttimereq(trlx);                                  <<03044>>01370000
value trlx;                                                    <<03044>>01375000
integer trlx;                                                  <<03044>>01380000
option external;                                               <<03044>>01385000
                                                               <<03044>>01390000
                                                                        01395000
procedure dequeuediscreq(reqp,ditp);                                    01400000
value reqp,ditp;                                                        01405000
integer reqp,ditp;                                                      01410000
option external;                                                        01415000
                                                                        01420000
                                                                        01425000
integer procedure removestop(proc,pin,dbugid,ploc,info,plabl,  <<06678>>01430000
                             mode);                            <<06678>>01435000
  value proc,pin,dbugid,ploc;                                  <<06678>>01440000
  integer proc,pin,plabl,mode,ploc;                            <<06678>>01445000
  double dbugid;                                               <<06678>>01450000
  integer array info;                                          <<06678>>01455000
  option external,variable;                                    <<06678>>01460000
                                                                        01465000
procedure receivemsg(portnum,msglength,flags);                          01470000
value portnum,msglength,flags;                                          01475000
integer portnum,msglength;                                              01480000
logical flags;                                                          01485000
option external;                                                        01490000
                                                                        01495000
$include inclkcim                                              <<06239>>01500000
                                                                        01505000
procedure rel'phy'cst(phycst);                                 <<06283>>01510000
   value phycst;                                               <<06283>>01515000
   integer phycst;                                             <<06283>>01520000
   option external;                                            <<06283>>01525000
logical procedure checkalive(pin);                             <<06951>>01530000
value pin; integer pin;                                        <<06951>>01535000
option external;                                               <<06951>>01540000
                                                               <<06951>>01545000
                                                                        01550000
$include inclvmc                                                        01555000
                                                                        01560000
$page " "                                                               01565000
comment                                                                 01570000
                                                                        01575000
setdbtostack replaces the contents of the db register with              01580000
the absolute address of the stack base, and returns the old             01585000
db register contents                                                    01590000
                                                                        01595000
;                                                                       01600000
                                                                        01605000
                                                                        01610000
                                                                        01615000
double procedure setdbtostack;                                          01620000
option uncallable, privileged, internal;                                01625000
                                                                        01630000
                                                                        01635000
begin                                                                   01640000
                                                                        01645000
x:=absolute(qi);  <<ics' qi>>                                           01650000
tos:=absolute(x:=x-5);               <<stack bank>>                     01655000
tos:=absolute(x:=x+1);                <<stack db>>                      01660000
assemble(xchd);                                                         01665000
setdbtostack := tos;                                                    01670000
end <<setdbtostack>> ;                                                  01675000
                                                                        01680000
procedure mmlog(pxfix,pcbi,n,inc);                                      01685000
   value      pxfix,pcbi,n,inc;                                         01690000
   integer    pointer pxfix;                                            01695000
   integer    pcbi,n,inc;                                               01700000
   option     uncallable,privileged;                                    01705000
   begin                                                                01710000
integer pcbpt;                                                 <<06651>>01715000
     logical array qarray(*) = q+0;                            <<06636>>01720000
     logical pxfixedloc;                                       <<06636>>01725000
      define sysprocess=procstate.systemprocflag#;             <<06651>>01730000
          pcbpt := pcbi;                                       <<06651>>01735000
         if sysprocess then return;    <<ignore>>                       01740000
         pxfixed; <<get ready to use pxfixed include file>>    <<06636>>01745000
         tos _ pxfxvsused; <<total vds currently assigned>>    <<06636>>01750000
         if >= then                                                     01755000
          begin                        <<sum>>                          01760000
           tos _ tos+inc;                                               01765000
           if < then                                                    01770000
            begin                      <<overflow>>                     01775000
             del;                                                       01780000
             tos _ -1;                                                  01785000
            end;                                                        01790000
          end;                                                          01795000
         pxfxvsused _ tos;               <<update>>            <<06636>>01800000
         if logical(n) > pxfxmaxdsused then                    <<06636>>01805000
          pxfxmaxdsused _ n;  <<new max data seg size>>        <<06636>>01810000
   end <<mmlog>> ;                                                      01815000
                                                                        01820000
comment  allocate one entry from the table(type), where                 01825000
         type = cstb     from cst table (sl area only)                  01830000
                dstb     from dst table                                 01835000
                pcbb     from pcb table                                 01840000
                                                                        01845000
         returns a value > 0 if successful, otherwise a                 01850000
         zero is returned.                                              01855000
         note* the entry will be zeroed.                                01860000
         ;                                                              01865000
integer procedure getentry(type);                                       01870000
value      type;                                                        01875000
integer    type;                                                        01880000
option     uncallable,privileged;                                       01885000
                                                                        01890000
begin                                                                   01895000
                                                                        01900000
integer entryindex;                                                     01905000
pdisable;                                                               01910000
tos:=%1000d;                                                            01915000
asmb(xchd);                                                             01920000
entryindex := getsystabentry(type,false,false);                <<06755>>01925000
if entryindex = 0 then getentry := 0 else                      <<06617>>01930000
   begin <<an entry is available>>                                      01935000
   x := type&lsl(2) + 2;                                       <<06617>>01940000
   tos := dst(x);                                              <<06617>>01945000
   tos := dst(x + 1);                                          <<06617>>01950000
   assemble(xchd);                                             <<06617>>01955000
   ddel;                                                       <<06617>>01960000
   x := 0;                                                     <<06617>>01965000
   getentry := entryindex/systabentrysize;                     <<06617>>01970000
   enable;  <<left us disabled>>                               <<01561>>01975000
   end;                                                                 01980000
asmb(xchd);                                                             01985000
penable;                                                                01990000
end <<getentry>> ;                                                      01995000
                                                                        02000000
                                                                        02005000
comment  return one entry to the table(type), where                     02010000
         type = cstb into the cst table (sl area only)                  02015000
                dstb into dst table                                     02020000
                pcbb into pcb table                                     02025000
;                                                                       02030000
                                                                        02035000
procedure returnentry(type,en);                                         02040000
value      type,en;                                                     02045000
integer    type,en;                                                     02050000
option     uncallable,privileged;                                       02055000
begin                                                                   02060000
                                                                        02065000
logical pointer                                                <<06617>>02070000
  pcb = pcbb;                                                  <<06617>>02075000
logical                                                        <<06617>>02080000
   entryindex;                                                 <<06617>>02085000
pdisable;                                                               02090000
tos:=%1000d;                                                            02095000
asmb(xchd);                                                             02100000
x := type&lsl(2) + 2;                                          <<06617>>02105000
tos := dst(x);                                                 <<06617>>02110000
tos := dst(x + 1);                                             <<06617>>02115000
asmb(xchd);                                                    <<06617>>02120000
ddel;                                                          <<06617>>02125000
x := 0;                                                        <<06617>>02130000
entryindex := en * systabentrysize;                            <<06617>>02135000
<< if entry in pcb, set last word in the entry to -1 for >>    <<01909>>02140000
<< the benefit of checkalive (kernelc):                  >>    <<01909>>02145000
if type = pcbb then                                            <<06651>>02150000
   pcb(entryindex + pqptrwordnum) := -1;                       <<06617>>02155000
relsystabentry(type,entryindex);                               <<06617>>02160000
enable; <<left us disabled>>                                   <<01561>>02165000
asmb(xchd);                                                             02170000
penable;                                                                02175000
end <<returnentry>> ;                                                   02180000
                                                                        02185000
$page "PROGRAM BLOCK ALLOCATION : ALCSTBLOCK"                           02190000
                                                                        02195000
comment  this function is called to allocate a block of n conti         02200000
         cst entries from the cst extension block;                      02205000
                                                                        02210000
integer procedure alcstblock(n);                                        02215000
value      n;                                                           02220000
integer    n;                                                           02225000
option     uncallable,privileged;                                       02230000
                                                                        02235000
begin                                                                   02240000
integer  eix=alcstblock,cstx,max,cc:=cce;                               02245000
pdisable;                                                               02250000
eix := 0;                                                               02255000
max := cstblk'(0);     <<table size>>                          <<04150>>02260000
while (eix:=eix+1) <= max do                                   <<04150>>02265000
   if cstblk'(eix) = -1 then                                   <<04150>>02270000
   goto foundl;             <<allocate entry>>                 <<04150>>02275000
cc := ccl;         <<no more entries>>                         <<04150>>02280000
go quit;                                                       <<04150>>02285000
                                                               <<04150>>02290000
foundl:                                                        <<04150>>02295000
                                                               <<04150>>02300000
x := (cstx:=dfs)+2;                                                     02305000
if (n:=n+1) > dst(x) then                                      <<01636>>02310000
   begin                        <<insufficient entries>>                02315000
   cc := ccl;                                                           02320000
   go quit;                                                             02325000
   end;                                                                 02330000
dsti'(x) := dsti'(x)-n;        <<dec free count>>                       02335000
cstx := cstx+dsti'(x:=x+1);     <<index to next free>>                  02340000
dsti'(x) := dsti'(x)+n&lsl(2); <<new next free>>                        02345000
cstblk'(eix) := cstx;      <<save index>>                      <<04150>>02350000
<<zero out the bitmap>>                                                 02355000
dsti'(cstx):=(n:=n-1);                                         <<01636>>02360000
dsti'(x:=x+1) := %125252;       <<check word>>                          02365000
dsti'(x:=x+1) := 0;             <<# sharing block>>                     02370000
dsti'(x:=x+1) := 0;                                                     02375000
while (n:=n-1) >= 0 do                                                  02380000
   begin                        <<clear entries>>                       02385000
   dsti'(x:=x+1) := %100000;                                            02390000
   dsti'(x:=x+1) := 0;                                                  02395000
   dsti'(x:=x+1) := 0;                                                  02400000
   dsti'(x:=x+1) := 0;                                                  02405000
   end;                                                                 02410000
mmstat'(-alcstblk,eix,cstx,n,0,0,0);                           <<06953>>02415000
quit   : status.ccfld := cc;                                            02420000
penable;                                                                02425000
end <<alcstblock>> ;                                                    02430000
                                                                        02435000
$page "PROGRAM BLOCK ALLOCATION : DEALCSTBLOCK"                         02440000
                                                                        02445000
procedure dealcstblock(eix);                                            02450000
value      eix;                                                         02455000
integer    eix;                                                         02460000
option     uncallable,privileged;                                       02465000
                                                                        02470000
begin                                                                   02475000
integer  cstx,max,mcnt,n,m,i,k,lcsw,cc:=cce;                            02480000
double objid := 0d;                                            <<06661>>02485000
logical array objident(*) = objid;                             <<06661>>02490000
                                                               <<06661>>02495000
trapsoff;                                                               02500000
disable;                                                                02505000
cstx := cstblk'(eix);                                                   02510000
if dsti'(cstx+1) <> %125252 then                                        02515000
   begin                        <<invalid block index>>                 02520000
   cc := ccl;                                                           02525000
   go quit;                                                             02530000
   end;                                                                 02535000
n := dsti'(x:=x-1)+1;           <<number to return>>                    02540000
i := 0; m := cstx+4;                                                    02545000
<<check and return memory if necessary>>                                02550000
while (i:=i+1) < n do                                                   02555000
   begin                                                                02560000
   enable;                                                              02565000
   disable;                                                             02570000
                                                               <<01558>>02575000
   checkagain:                                                 <<01558>>02580000
                                                               <<01558>>02585000
   cstx:=cstblk'(eix); <<may have changed>>                    <<01558>>02590000
   objident(objidnumfield) := (m-cstx) & lsr(2);               <<06661>>02595000
   objident(objidpbxfield) := eix;                             <<06661>>02600000
   objident(objidtypefield) := pbxobject;                      <<06661>>02605000
   if dsti'(m) < 0 then                                                 02610000
      begin <<segment is absent>>                                       02615000
      x:=x+1;                                                           02620000
      if logical(dsti'(x)).imiflag or                                   02625000
      logical(dsti'(x)).rocflag then                                    02630000
         begin <<damn thing is coming in>>                              02635000
         queueonobject(objid);                                 <<06661>>02640000
         go checkagain;                                        <<01558>>02645000
         end;                                                           02650000
      end                                                               02655000
   else                                                                 02660000
      begin <<seg is present>>                                          02665000
      dsti'(x:=m):=%100000;                                             02670000
      tos:=dsti'(x:=x+2);                                               02675000
      tos:=dsti'(x:=x+1);                                               02680000
      tos:=tos+rbtoobjidentdisp;                               <<06239>>02685000
      asmb(ldea);         <<********************>>             <<06661>>02690000
      objid := tos;                                            <<06661>>02695000
      tos := 0d;                                               <<06661>>02700000
      asmb(sdea);                                              <<06661>>02705000
      tos:=tos+objidenttorbdisp;                               <<06239>>02710000
      sendmsg(schedpin,relregreqport,2,0);                              02715000
      end;                                                              02720000
   m := m+4;                                                            02725000
   end;                                                                 02730000
cstblk'(eix):=-1;                                                       02735000
dsti'(cstx):=%100000;                                                   02740000
x := dfs+2;                                                             02745000
dsti'(x) := dsti'(x)+n;        <<inc free count>>                       02750000
tos := dsti'(x:=x+1);           <<index to next free>>                  02755000
dsti'(x) := dsti'(x)-(n:=n&lsl(2));     <<new index>>                   02760000
if (mcnt:=tos+dfs-(cstx+n)) = 0 then                                    02765000
goto skipl;                  <<move count = 0>>                         02770000
tos := 0;                                                               02775000
tos := absolute(dstb)+cstx;           <<destination address>>           02780000
asmb(ddup);                                                             02785000
tos := tos+n;                  <<source address>>                       02790000
tos := mcnt;                   <<count>>                                02795000
asmb(mabs 5);                 <<move absolute>>                         02800000
skipl:                                                         <<06953>>02805000
mmstat'(-dealcstblk,eix,cstx,mcnt,0,0,0);                      <<06953>>02810000
eix := 0;                                                               02815000
max := cstblk'(0);             <<table size>>                           02820000
while (eix:=eix+1) <= max do                                            02825000
   begin                                                       <<*7741>>02830000
   if cstblk'(eix) <> -1 then                                  <<*7741>>02835000
      begin                                                    <<*7741>>02840000
      if logical(cstblk'(eix)) > logical(cstx) then            <<*7741>>02845000
      cstblk'(x) := cstblk'(x)-n;  << adjust index >>          <<*7741>>02850000
      end;                                                     <<*7741>>02855000
   end;                                                        <<*7741>>02860000
quit   : status.ccfld := cc;                                            02865000
end <<dealcstblock>> ;                                                  02870000
                                                                        02875000
$page "PROGRAM BLOCK ALLOCATION : PUTCSTBLOCK"                          02880000
                                                                        02885000
comment  this procedure is called to initialize a cst extension         02890000
         entry.                                                         02895000
         ;                                                              02900000
                                                                        02905000
procedure putcstblock(eix,lsegnum,size,ldev,diskadr,sysflag);  <<03775>>02910000
value      eix,lsegnum,size,ldev,diskadr,sysflag;              <<03775>>02915000
integer    eix,lsegnum,size,ldev;                                       02920000
double     diskadr;                                                     02925000
logical    sysflag;                                            <<03775>>02930000
option     uncallable,privileged;                                       02935000
                                                                        02940000
                                                                        02945000
begin                                                                   02950000
define hodiskadr=(8:8)#;                                       <<03775>>02955000
integer  cstx,cc:=cce,hoda=diskadr,loda=hoda+1;                         02960000
pdisable;                                                               02965000
cstx := cstblk'(eix);          <<cst block index>>                      02970000
if cstx=-1 then                                                         02975000
   begin                                                                02980000
   cc:=ccl;                                                             02985000
   go quit;                                                             02990000
   end;                                                                 02995000
if (lsegnum<0) or (lsegnum>=dsti'(cstx)) then                           03000000
   begin                        <<out of range>>                        03005000
   cc := ccg;                                                           03010000
   go quit;                                                             03015000
   end;                                                                 03020000
if dsti'(x:=x+1) <> %125252 then                                        03025000
   begin                        <<invalid cst block>>                   03030000
   cc := ccl;                                                           03035000
   go quit;                                                             03040000
   end;                                                                 03045000
x := cstx+lsegnum&lsl(2)+4;    <<actual index>>                         03050000
tos := size;                                                            03055000
tos.abit := 1;                 <<mark absent>>                          03060000
dsti'(x) := tos;               <<store desc>>                           03065000
tos:=0;                                                                 03070000
if sysflag then tos.systemflag := 1;                           <<03775>>03075000
dsti'(x:=x+1):=tos;                                                     03080000
dsti'(x:=x+1):=ldev&lsl(8)+hoda.hodiskadr;                     <<03775>>03085000
dsti'(x:=x+1) := loda;                                                  03090000
                                                                        03095000
quit:                                                                   03100000
                                                                        03105000
status.ccfld := cc;                                                     03110000
penable;                                                                03115000
end <<putcstblock>> ;                                                   03120000
                                                                        03125000
$page "DATA SEGMENT ALLOCATION : RELDATASEG"                            03130000
                                                                        03135000
                                                                        03140000
comment  this function is called to return resources for                03145000
         a stack or extra data segment;                                 03150000
                                                                        03155000
procedure reldataseg(en);                                               03160000
value      en;                                                          03165000
integer    en;                                                          03170000
option     uncallable,privileged;                                       03175000
                                                                        03180000
begin                                                                   03185000
integer  k,lcsw,type:=dstb;                                             03190000
integer descstinx;                                             <<06661>>03195000
                                                               <<06661>>03200000
double objid := 0d;                                            <<06661>>03205000
logical array objident(*) = objid;                             <<06661>>03210000
                                                               <<06661>>03215000
logical it'sastack,segpresent:=true;                                    03220000
entry    relcodeseg;                                                    03225000
                                                               <<06661>>03230000
                                                               <<06661>>03235000
descstinx:=en&lsl(2);                                                   03240000
if logical(dst(descstinx+1)).stkflag                                    03245000
then it'sastack:=true                                                   03250000
else it'sastack:=false;                                                 03255000
if en <= %105 then suddendeath(124);  <<trying to rel sys dst>><<07322>>03260000
go start;                                                               03265000
                                                               <<06661>>03270000
relcodeseg:                                                             03275000
removestop(%100000,0,double(en),-1);        <<sys b.p.>>       <<06678>>03280000
removestop(-1,-1,double(en),-1);             <<user b.p.>>     <<06678>>03285000
it'sastack:=false;                                                      03290000
descstinx := en&lsl(2)+dfc;                                             03295000
type := cstb;                                                           03300000
                                                               <<06661>>03305000
start  : pdisable;                                                      03310000
disable;                                                                03315000
if type <> dstb                                                <<06661>>03320000
   then objident(objidtypefield) := slobject                   <<06661>>03325000
else objident(objidtypefield) := dataobject;                   <<06661>>03330000
                                                               <<06661>>03335000
objident(objidnumfield) := en;                                 <<06661>>03340000
                                                               <<06661>>03345000
trapsoff;                                                               03350000
                                                               <<01558>>03355000
checkagain:                                                    <<01558>>03360000
                                                               <<01558>>03365000
dsti'(descstinx).abit := 1;          <<mark absent>>                    03370000
if <> then                                                              03375000
    begin <<absent>>                                                    03380000
    x:=x+1;                                                             03385000
    if logical(dsti'(x)).imiflag or                                     03390000
    logical(dsti'(x)).fwipflag <<part of cleaned region>> or   <<01561>>03395000
    logical(dsti'(x)).rocflag then                                      03400000
       begin                                                            03405000
       queueonobject(objid);                                   <<06661>>03410000
       pdisable;                                                        03415000
      go checkagain;                                           <<01558>>03420000
       end                                                              03425000
    else                                                                03430000
       begin <<stays absent>>                                           03435000
       segpresent:=false;                                               03440000
       end;                                                             03445000
    end;                                                                03450000
if segpresent then                                                      03455000
    begin <<release main memory region>>                                03460000
                                                               <<s8579>>03465000
    if type=cstb and dstl'(descstinx+1).systemflag             <<s8579>>03470000
       then suddendeath(629);                                  <<s8579>>03475000
                                                               <<s8579>>03480000
    dsti'(descstinx).abit:=1;                                           03485000
    if dst(x:=x+1).segresidentflag=1 then suddendeath(630);    <<01636>>03490000
    tos:=dsti'(x:=x+1);                                                 03495000
    tos:=dsti'(x:=x+1);                                                 03500000
    tos:=tos+rbtorasdisp;                                               03505000
    assemble(lsea);                                                     03510000
    asmb(tbc regiofzbit);                                               03515000
    if <> then suddendeath(631); <<rel i/o fzn seg?>>          <<01636>>03520000
    asmb(del);                                                          03525000
    tos:=tos+rastohodadisp;                                             03530000
    assemble(ldea);                                                     03535000
    dsti'(x):=tos;                                                      03540000
    dsti'(x:=x-1):=tos; <<put disc address in descriptor>>              03545000
    tos:=tos+hodatoobjidentdisp;                               <<06239>>03550000
    tos := 0d;                                                 <<06661>>03555000
    asmb(sdea); <<so region will be cleaned properly>>         <<06661>>03560000
    tos:=tos+objidenttorbdisp;                                 <<06239>>03565000
    sendmsg(schedpin,relregreqport,2,0);                                03570000
    end;                                                                03575000
if type = dstb then                                                     03580000
    begin  <<release swap region>>                                      03585000
    releaseswapregion(en);                                              03590000
   if <> then suddendeath(632);                                <<01636>>03595000
    end;                                                                03600000
if logicalmapping and type = cstb and                          <<06283>>03605000
   en <= total'phy'cst'num then                                <<06283>>03610000
   rel'phy'cst(en)                                             <<06283>>03615000
else                                                           <<06283>>03620000
returnentry(type,en);         <<return entry>>                          03625000
penable;                                                       <<04608>>03630000
mmstat'(-relresources,en,type,0,0,0,0);                        <<06953>>03635000
if ics(-icspdisablecntcell) > 0 then                           <<02092>>03640000
   comment:  the purpose of the following code is to cover up  <<k7569>>03645000
             a pdisable problem in which an interrupt handler  <<k7569>>03650000
             appears to execute a pdisable without a           <<k7569>>03655000
             corresponding penable.  this strange problem      <<k7569>>03660000
             always appears to leave the pdisable count at 1.  <<k7569>>03665000
             if this condition is met, we shall execute a      <<k7569>>03670000
             penable on behalf of the defective software       <<k7569>>03675000
             [a small prayer is in order here] and continue    <<k7569>>03680000
             execution (soft'death will log this event). ;     <<k7569>>03685000
                                                               <<k7569>>03690000
   if ics(-icspdisablecntcell) = 1 then                        <<k7569>>03695000
      begin                                                    <<k7569>>03700000
      penable;  <<it's a miracle>>                             <<k7569>>03705000
      soft'death(634);                                         <<k7569>>03710000
      end                                                      <<k7569>>03715000
   else                                                        <<k7569>>03720000
      suddendeath(634);     <<leave the sf hook in>>           <<k7569>>03725000
end <<reldataseg>> ;                                                    03730000
                                                                        03735000
$page "DATA SEGMENT ALLOCATION : GETDATASEG"                            03740000
                                                                        03745000
comment  this function is called to create an extra data segmen         03750000
         or stack. a dst entry and vds are allocated and                03755000
         the dst entry is initialized to an absent state.               03760000
         the entry point for stack allocation is called                 03765000
         getstack;                                                      03770000
                                                                        03775000
integer procedure getdataseg(memsize,vdsizei);                 <<*8590>>03780000
value      memsize,vdsizei;                                    <<*8590>>03785000
integer    memsize,vdsizei;                                    <<*8590>>03790000
option     uncallable,privileged;                                       03795000
                                                                        03800000
begin                                                                   03805000
entry    getstack,getdatasegc;                                          03810000
                                                               <<*8590>>03815000
logical vdsize = vdsizei,                                      <<*8590>>03820000
        extra := 0;                                            <<*8590>>03825000
logical array qarray(*) = q + 0;                               <<06636>>03830000
logical pxfixedloc;                                            <<06636>>03835000
double   da;                                                            03840000
integer  en,crit,da1=da,da2=da+1,cc:=cce;                      <<*8590>>03845000
logical  stack:=false;                                                  03850000
logical clear:=false;                                                   03855000
go start;                                                               03860000
                                                                        03865000
getstack:   stack:=true;                                                03870000
            extra := 1536;                 <<1152+384>>                 03875000
                                                                        03880000
getdatasegc: clear:=true;                                               03885000
start  : trapsoff;                                                      03890000
comment                                                        <<04641>>03895000
the memory size has to be a multiple of 4 with a maximum       <<04641>>03900000
value of 32764. all requests up to 32764 will be rounded up    <<04641>>03905000
and requests over that will end up getting 32764 words.        <<04641>>03910000
;                                                              <<04641>>03915000
tos := if memsize <= 32760 then                                <<s7966>>03920000
          ((memsize + 3)/4 + 1) * 4                            <<s7966>>03925000
       else                                                    <<04641>>03930000
          32764;                                               <<s7966>>03935000
duplicate;                                                              03940000
if tos > vdsize then                                                    03945000
    begin                        <<use memory size>>                    03950000
    duplicate;                                                          03955000
    vdsize := tos;                                                      03960000
    end;                                                                03965000
memsize := tos;                                                         03970000
crit := setcritical;                                                    03975000
                                                                        03980000
<<get a segment table entry for the data segment>>                      03985000
                                                                        03990000
tos := getentry(dstb);         <<allocate dst entry>>                   03995000
asmb(test);                                                             04000000
if = then                                                               04005000
    begin                        <<none available>>                     04010000
    cc := ccg;                                                          04015000
    go quit;                                                            04020000
    end;                                                                04025000
en := tos;                                                              04030000
<<get a swap region for the data segment>>                              04035000
                                                                        04040000
tos := getswapregion(en,vdsize+extra,0);                                04045000
asmb(dtst);                                                             04050000
if = then                                                               04055000
    begin                        <<none available>>                     04060000
    cc := ccl;                                                          04065000
    returnentry(dstb,en);       <<release dst entry>>                   04070000
    go quit;                                                            04075000
    end;                                                                04080000
da := tos;                                                              04085000
                                                                        04090000
<<fill in the segment table entry for the data segment>>                04095000
                                                                        04100000
x := en&lsl(2);                                                         04105000
dsti'(x) := logical(memsize&lsr(2)) lor %100000;                        04110000
tos:=da1; <<hoda>>                                                      04115000
dsti'(x:=x+2):=tos;                                                     04120000
dsti'(x:=x+1):=da2;                                                     04125000
dst(en&lsl(2)+1).disccopyvalidflag:=1;                                  04130000
getdataseg := en;                                                       04135000
if stack then                                                           04140000
    begin                        <<ignore logging>>                     04145000
    dst  (en&lsl(2)+1).stkflag:=1;                                      04150000
    go quit;                                                            04155000
   end;                                                                 04160000
pdisable;                                                               04165000
tos := setdbtostack;                                                    04170000
pxfixed; <<get ready to use pxfixed include file>>             <<06636>>04175000
tos:=@qarray(pxfixedloc);                                      <<06636>>04180000
tos := curprc;                                                 <<06651>>04185000
tos := (vdsize+logical(psm1))/128;      << page count >>       <<*8590>>04190000
duplicate;                                                              04195000
mmlog(*,*,*,*);               <<log allocation>>                        04200000
assemble( xchd; ddel);                                                  04205000
penable;                                                                04210000
<<zero out swap region on disc if required>>                   <<01558>>04215000
if clear then                                                  <<01558>>04220000
   begin <<zap on disc>>                                       <<01558>>04225000
   tos:=attachio(da1.ldevnfield,0,0,0,zerofill,                <<01558>>04230000
   logical(dsti'(en&lsl(2)+1)).vmalloc*vmpagesize,da1.hodafield<<01558>>04235000
   ,da2,blocked);                                              <<01558>>04240000
   asmb(del);                                                  <<01558>>04245000
   if tos.(13:3)<>1 then suddendeath(680);                     <<01558>>04250000
   <<i/o error on attempt to zero out swap region>>            <<01558>>04255000
   end;                                                        <<01558>>04260000
quit   : status.ccfld := cc;                                            04265000
resetcritical(crit);                                                    04270000
end <<getdataseg:getstack>> ;                                           04275000
                                                                        04280000
$page "SL SEGMENT ALLOCATION : PUTCST"                                  04285000
                                                                        04290000
                                                                        04295000
comment  this procedure is called to initialize a cst entry             04300000
         which was allocated by calling the function get-               04305000
         entry or getentrys. an error will be returned if               04310000
         the cst entry number en is out of range or the                 04315000
         entry has already been initialized.                            04320000
         ;                                                              04325000
                                                                        04330000
procedure putcst(en,mask,ldev,diskadr,sysflag);                <<03775>>04335000
value      en,mask,ldev,diskadr,sysflag;                       <<03775>>04340000
integer    en,mask,ldev;                                                04345000
double     diskadr;                                                     04350000
logical    sysflag;                                            <<03775>>04355000
option     uncallable,privileged;                                       04360000
begin                                                                   04365000
define hodiskadr=(8:8)#;                                       <<03775>>04370000
integer  cc:=cce,hoda=diskadr,loda=diskadr+1;                           04375000
if (en<=0) or (en>f(f(0))) then                                <<06105>>04380000
   begin                        <<out of range>>                        04385000
   cc := ccl;                                                           04390000
   go quit;                                                             04395000
   end;                                                                 04400000
tos:=en&lsl(2)+dfc;                                                     04405000
if dsti'(tos) <> 0 then                                                 04410000
   begin                        <<already initialized>>                 04415000
   cc := ccg;                                                           04420000
   go quit;                                                             04425000
   end;                                                                 04430000
disable;                                                                04435000
tos := mask;                                                            04440000
tos.abit := 1;                                                          04445000
dsti'(x) := tos;                                                        04450000
tos:=0;                                                                 04455000
if sysflag then tos.systemflag := 1;                           <<03775>>04460000
dsti'(x:=x+1):=tos;                                                     04465000
dsti'(x:=x+1):=ldev&lsl(8)+hoda.hodiskadr;                     <<03775>>04470000
dsti'(x:=x+1) := loda;                                                  04475000
quit   : status.ccfld := cc;                                            04480000
end <<putcst>> ;                                                        04485000
                                                                        04490000
$page "SEGMENT EXPANSIONS/CONTRACTIONS : RELEASE INTERNAL REGION"       04495000
                                                                        04500000
procedure relinternalregion(relpagecnt,rbrelsource);                    04505000
value relpagecnt,rbrelsource;                                           04510000
integer relpagecnt,rbrelsource;                                         04515000
option privileged,uncallable,internal;                                  04520000
                                                                        04525000
comment                                                                 04530000
                                                                        04535000
relinternalregion is called when a pcbx or dl contraction of at         04540000
least one main memory page is to take place in the caller's sta         04545000
                                                                        04550000
it is assumed that db is at the oldregionbase, and that a pdiab         04555000
is in effect.                                                           04560000
                                                                        04565000
the region header and stack pcbx up to the source are moved up          04570000
by the specified number of pages. the region below the stack is         04575000
placed in a reserved state and a msg is sent for it to be relea         04580000
                                                                        04585000
after the move is complete, the stack's new address is placed           04590000
in the descriptor, as is the new size, and the stack is flagged         04595000
present.                                                                04600000
                                                                        04605000
;                                                                       04610000
                                                                        04615000
begin                                                                   04620000
                                                                        04625000
double oldregionbase,savedb,                                            04630000
       newregionbase;                                                   04635000
integer oldregionsize,                                                  04640000
        stackdst,                                                       04645000
        newregionsize,                                                  04650000
        relwordcount;                                                   04655000
                                                                        04660000
                                                                        04665000
<<get old stack base from descriptor,put in new base>>                  04670000
                                                                        04675000
stackdst:=absolute(absolute(qi)-icsstkdstcell);                         04680000
tos:=dst(x:=stackdst&lsl(2)+2); <<bank>>                                04685000
tos:=dst(x:=x+1); <<address>>                                           04690000
asmb(ddup);                                                             04695000
oldregionbase:=tos;                                                     04700000
tos:=relpagecnt&lsl(pagepower);                                         04705000
relwordcount:=s0;                                                       04710000
asmb(ladd,ddup;ddup);                                                   04715000
newregionbase:=tos;                                                     04720000
disable;                                                       <<04773>>04725000
dst(x):=tos;                                                            04730000
dst(x:=x-1):=tos;                                                       04735000
f(f(qi)-9):=s0;   <<abs stack addr>>                                    04740000
enable;                                                        <<04773>>04745000
<<move the header and part of the pcbx to new positions>>               04750000
                                                                        04755000
tos:=rbrelsource+relwordcount; <<move destination>>                     04760000
tos:=rbrelsource;   <<move source>>                                     04765000
tos:=-(rbrelsource+headerlength); <<move count>>                        04770000
tos:=oldregionbase;                                                     04775000
asmb(xchd);                                                             04780000
savedb:=tos;                                                            04785000
asmb(move);                                                             04790000
tos:=savedb;                                                            04795000
asmb(xchd;ddel);                                                        04800000
                                                                        04805000
                                                                        04810000
<<fix up header & trailer in region below-send release msg>>            04815000
                                                                        04820000
tos:=oldregionbase;                                                     04825000
tos:=tos+rbtorasdisp;                                                   04830000
tos:=regreservedcode;                                                   04835000
asmb(ssea);                                                             04840000
tos:=tos+rastorsdisp;                                                   04845000
asmb(lsea);                                                             04850000
oldregionsize:=tos;                                                     04855000
newregionsize:=oldregionsize-relpagecnt;                                04860000
tos:=relpagecnt;                                                        04865000
asmb(ssea);                                                             04870000
tos:=tos+rstossdisp;                                                    04875000
tos:=relpagecnt;                                                        04880000
asmb(ssea);                                                             04885000
tos:=tos+sstoobjidentdisp;                                     <<06239>>04890000
tos := 0d;                                                     <<06661>>04895000
asmb(sdea);                                                    <<06661>>04900000
tos:=tos+objidenttoptrasdisp+relwordcount;                     <<06239>>04905000
tos:=regreservedcode;                                                   04910000
asmb(ssea);                                                             04915000
tos:=tos+trastotrsdisp;                                                 04920000
tos:=relpagecnt;                                                        04925000
asmb(ssea);                                                             04930000
tos:=tos+trstotssdisp;                                                  04935000
tos:=relpagecnt;                                                        04940000
asmb(ssea);                                                             04945000
tos:=oldregionbase;                                                     04950000
sendmsg(schedpin,relregreqport,2,0);                                    04955000
                                                                        04960000
<<update header/trailer size cells of stack's new region>>              04965000
                                                                        04970000
tos:=newregionbase;                                                     04975000
tos:=tos+rbtorsdisp;                                                    04980000
tos:=newregionsize;                                                     04985000
asmb(ssea);                                                             04990000
tos:=tos+rstossdisp;                                                    04995000
tos:=newregionsize;                                                     05000000
asmb(ssea);                                                             05005000
tos:=tos+sstorasdisp;                                                   05010000
tos:=regassignedcode;                                                   05015000
asmb(ssea);                                                             05020000
tos:=tos+rastoptrsdisp+newregionsize&lsl(pagepower);                    05025000
tos:=newregionsize;                                                     05030000
asmb(ssea);                                                             05035000
tos:=tos+trstotssdisp;                                                  05040000
tos:=newregionsize;                                                     05045000
asmb(ssea);                                                             05050000
tos:=tos+tsstotrasdisp;                                                 05055000
tos:=regassignedcode;                                                   05060000
asmb(ssea);                                                             05065000
end  <<relinternalregion>>;                                             05070000
                                                                        05075000
$page "SEGMENT EXPANSIONS/CONTRACTIONS : ALTDSEGSIZE"                   05080000
                                                                        05085000
comment                                                                 05090000
                                                                        05095000
altdsegsize is called to modify (expand or contract) the space          05100000
allocated to a data segment.  the new segment size is returned.         05105000
                                                                        05110000
;                                                                       05115000
                                                                        05120000
                                                                        05125000
integer procedure altdsegsize(en,size);                                 05130000
value      en,size;                                                     05135000
integer    en,size;                                                     05140000
option     uncallable,privileged;                                       05145000
                                                                        05150000
                                                                        05155000
begin                                                                   05160000
integer  inx,ref,crit,cc:=cce,ns=altdsegsize;                           05165000
equate   altcode   =5;                                                  05170000
integer pagesrequired,oldsize,newsize;                                  05175000
                                                               <<06661>>05180000
define                                                         <<06661>>05185000
   objident = double(en)#;                                     <<06661>>05190000
                                                               <<06661>>05195000
if ics(-icspdisablecntcell) > 0 then                           <<02092>>05200000
   comment:  the purpose of the following code is to cover up  <<k7569>>05205000
             a pdisable problem in which an interrupt handler  <<k7569>>05210000
             appears to execute a pdisable without a           <<k7569>>05215000
             corresponding penable.  this strange problem      <<k7569>>05220000
             always appears to leave the pdisable count at 1.  <<k7569>>05225000
             if this condition is met, we shall execute a      <<k7569>>05230000
             penable on behalf of the defective software       <<k7569>>05235000
             [a small prayer is in order here] and continue    <<k7569>>05240000
             execution (soft'death will log this event). ;     <<k7569>>05245000
                                                               <<k7569>>05250000
   if ics(-icspdisablecntcell) = 1 then                        <<k7569>>05255000
      begin                                                    <<k7569>>05260000
      penable;  <<it's a miracle>>                             <<k7569>>05265000
      soft'death(634);                                         <<k7569>>05270000
      end                                                      <<k7569>>05275000
   else                                                        <<k7569>>05280000
      suddendeath(634);     <<leave the sf hook in>>           <<k7569>>05285000
size := logical(size+3) land -4; <<round up>>                           05290000
trapsoff;                                                               05295000
forcestko;                                                              05300000
crit := setcritical;                                                    05305000
inx := en&lsl(2);              <<dst-relative index>>                   05310000
oldsize:=(dsti'(inx).dsfld)&lsl(2);                                     05315000
if (oldsize+psm1)/integer(vmpagesize)>dst(en&lsl(2)+1).npfld            05320000
then                                                           <<01636>>05325000
   begin <<exceeds vm allocation>>                             <<01636>>05330000
   cc:=ccg;altdsegsize:=oldsize;                               <<01636>>05335000
   go out;                                                     <<01636>>05340000
   end;                                                        <<01636>>05345000
tos:=newsize:=oldsize+size;                                             05350000
pagesrequired:=(tos+overhead-1)&lsr(pagepower)+1;                       05355000
altdsegsize:=newsize;                                                   05360000
if <= then                                                              05365000
   begin <<exceeds 32kw>>                                               05370000
   cc := ccg;altdsegsize:=oldsize;                                      05375000
   go out;                                                              05380000
   end;                                                                 05385000
if size > 0 then                                                        05390000
   begin                      <<expansion>>                             05395000
   tos := (ns+psm1)/integer(vmpagesize);                                05400000
   if tos > dst(en&lsl(2)+1).npfld then                                 05405000
      begin                   <<exceeds maxvds>>                        05410000
      cc:=ccg;altdsegsize:=oldsize;                                     05415000
      go out;                                                           05420000
      end;                                                              05425000
   end;                                                                 05430000
                                                                        05435000
again:                                                                  05440000
                                                                        05445000
disable;                                                                05450000
if dsti'(x:=en&lsl(2)) < 0 then                                         05455000
   begin <<seg is absent>>                                              05460000
   x:=x+1;                                                              05465000
   if logical(dsti'(x)).imiflag or logical(dsti'(x)).rocflag            05470000
   then queueonobject(objident) else                           <<06661>>05475000
       begin  <<ok, that's easy>>                                       05480000
       dsti'(x:=en&lsl(2)).dsfld:=ns&lsr(2);                            05485000
       go out;                                                          05490000
       end;                                                             05495000
   end;                                                                 05500000
getdatasegchangestate(en);                                              05505000
if < then                                                               05510000
   begin <<core resident,locked or frozen>>                             05515000
   cc:=ccl;altdsegsize:=oldsize;                                        05520000
   go out;                                                              05525000
   end;                                                                 05530000
if > then go again;                                                     05535000
disable;                                                                05540000
tos:=dsti'(en&lsl(2)+2); <<bank>>                                       05545000
tos:=dsti'(x:=x+1); <<base>>                                            05550000
tos:=tos+rbtorsdisp;                                                    05555000
asmb(lsea);                                                             05560000
if pagesrequired <= s0 or size < 0 then                                 05565000
   begin  <<ok-done>>                                                   05570000
   tos := mmstatspecreq;                                       <<*7596>>05575000
   tos := objident;                                            <<*7596>>05580000
   mmstat'(*,*,*,xds'contraction,size,0,0);                    <<*7596>>05585000
   disable;                                                             05590000
   dsti'(x:=en&lsl(2)).dsfld:=ns&lsr(2);                                05595000
   dsti'(x).abit:=0;                                                    05600000
   if gclassenabledmask.class0 and size < 0 then                        05605000
      begin  <<measure data seg contraction>>                           05610000
      tos:=measstatxdsbank;                                             05615000
      tos:=measstatxdsbase;                                             05620000
      tos:=tos+c0sub0'segreloff+c'dsegcontract;                <<ray.v>>05625000
      asmb(lsea);                                                       05630000
      tos:=tos+1;                                                       05635000
      asmb(ssea;ddel);                                                  05640000
      end;                                                              05645000
   go quit;                                                             05650000
   end;                                                                 05655000
disable;                                                                05660000
tos := objident;                                               <<06661>>05665000
tos := curprc;                                                 <<06651>>05670000
sendmsg(schedpin,makeabsentport,3,0);                          <<06661>>05675000
<<store away the info for the expansion>>                               05680000
genspecreq(objident,ns&lsr(2),0,0);                            <<06661>>05685000
if gclassenabledmask.class0 then                                        05690000
   begin  <<measure expansion of data seg>>                             05695000
   tos:=measstatxdsbank;                                                05700000
   tos:=measstatxdsbase;                                                05705000
   tos:=tos+c0sub0'segreloff+c'stopxdsexpand;                  <<ray.v>>05710000
   asmb(lsea);                                                          05715000
   tos:=tos+1;                                                          05720000
   asmb(ssea;ddel);                                                     05725000
   end;                                                                 05730000
if gclassenabledmask.class15 and size < 0 then                 <<01813>>05735000
   begin <<process level seg expansion>>                       <<01813>>05740000
   tos:=measprocxdsbank;                                       <<01813>>05745000
   tos:=measprocxdsbase;                                       <<01813>>05750000
   tos := tos + (curprc)/pcbsize*                              <<06651>>05755000
        class15'sub0size+cp'stopsegexpand;                     <<01813>>05760000
   asmb(lsea);                                                 <<01813>>05765000
   tos:=tos+1;                                                 <<01813>>05770000
   asmb(ssea;ddel);                                            <<01813>>05775000
   end;                                                        <<01813>>05780000
<<stuff away reason stopped in pcbx of process>>               <<01813>>05785000
<<done unconditionally for history for meas interface>>        <<01813>>05790000
tos:=ics(-icsstkbankcell);                                     <<01813>>05795000
tos:=ics(-icsstkbasecell)+pxglobsize+measstopreason'idx;       <<01813>>05800000
tos:=stopsegfault;                                             <<01813>>05805000
asmb(ssea;ddel);                                               <<01813>>05810000
tos := mmstatspecreq;                                          <<*7596>>05815000
tos := objident;                                               <<*7596>>05820000
mmstat'(*,*,*,xds'expansion,size,0,0);                         <<*7596>>05825000
queueonobject(objident);                                       <<06661>>05830000
go out;                                                                 05835000
quit   : penable;                                                       05840000
out   : status.ccfld := cc;                                             05845000
cpunum;                    << get cpu number >>                <<04662>>05850000
if tos= series64 then                                          <<04662>>05855000
                                                               <<04662>>05860000
  begin                                                        <<04662>>05865000
  asmb (pshr %100);        << tos-1:= db bnk tos:= db >>       <<04662>>05870000
  tos := dsti'(en&lsl(2)+2);                                   <<07067>>05875000
  tos := dsti'(x+1);                                           <<07067>>05880000
  assemble(dcmp);                                              <<07067>>05885000
  if = then      <<xfer limits only if db at altered data seg>><<07067>>05890000
                                                               <<04662>>05895000
    begin                  << db on extra data segment >>      <<04662>>05900000
    x:= en & lsl(2);       << x:= dst entry * 4 >>             <<04662>>05905000
    get'xdseg'limits;      << update xdseg limits on >>        <<04662>>05910000
    xfer'xdseg'limits;     << update cpu registers >>          <<04662>>05915000
    end;                                                       <<04662>>05920000
                                                               <<04662>>05925000
  end;                                                         <<04662>>05930000
                                                               <<04662>>05935000
resetcritical(crit);                                                    05940000
end <<altdsegsize>> ;                                                   05945000
                                                                        05950000
$page "SEGMENT EXPANSIONS/CONTRACTIONS : STACKSIZE"                     05955000
                                                                        05960000
comment  this function is called to determine the maximum               05965000
         stack segment size (z-dl). callable-capability 0-              05970000
         stack segment;                                                 05975000
                                                                        05980000
integer procedure stacksize(size);                                      05985000
value      size;                                                        05990000
integer    size;                                                        05995000
option     privileged;                                                  06000000
begin                                                                   06005000
equate   errn      =134,                                                06010000
         exitn     =1,                                                  06015000
         errex     =[10/errn,6/exitn];                         <<06636>>06020000
integer  cc:=cce;                                                       06025000
logical array qarray(*) = q+0;                                 <<06636>>06030000
logical pxfixedloc;                                            <<06636>>06035000
erroron;                                                                06040000
chek(errex,1);                                                          06045000
pxfixed; <<get ready to use pxfixed include file>>             <<06636>>06050000
if logical(size) > pxfxmaxstk then                             <<06636>>06055000
cc := ccg;                                                              06060000
stacksize := pxfxmaxstk;                                       <<06636>>06065000
status.ccfld := cc;                                                     06070000
errorexit(errex,0,0);                                                   06075000
end <<stacksize>> ;                                                     06080000
                                                                        06085000
$page "SEGMENT EXPANSIONS/CONTRACTIONS : DLSIZE"                        06090000
                                                                        06095000
comment  this function is called to expand or contract dl to db.        06100000
         the new value of dl to db is returned.                         06105000
         size      =requested (dl-db) size                              06110000
         dlsize    =granted (dl-db) size.                               06115000
         code :    cc=0 o.k. dlsize <= size.                            06120000
                   cc>0 o.k. dlsize := max(dl-db) > size.               06125000
                   cc<0 fails. illegal size(>0).                        06130000
                        dlsize := original(dl-db).                      06135000
         ;                                                              06140000
                                                                        06145000
integer procedure dlsize(size);                                         06150000
value      size;                                                        06155000
integer    size;                                                        06160000
option     privileged;                                                  06165000
                                                                        06170000
begin                                                                   06175000
integer  dlval,inx,inc,sz,total,maxinc,crit,lcsw,cc:=cce;               06180000
integer relpagecnt,relwordcnt,wordsrequired,pagesrequired,              06185000
requestedinc,newsz,rbrelsource,length;                                  06190000
logical  ref,pinx;                                                      06195000
logical array qarray(*) = q+0;                                 <<06636>>06200000
logical pxfixedloc;                                            <<06636>>06205000
integer stackdst,pcbpt;                                        <<06651>>06210000
double   cdb;                                                           06215000
equate   errn      =135,                                                06220000
         exitn     =1,                                                  06225000
         errex     =[10/errn,6/exitn],                                  06230000
         pxdl      =1,                                                  06235000
         pxdb=2,                                                        06240000
         extra     =1152,                                               06245000
         dlcode    =3;                                                  06250000
                                                               <<06661>>06255000
define sysprocess=procstate.systemprocflag#;                   <<06651>>06260000
 define  objident  = double(stackdst)#;                        <<06661>>06265000
                                                               <<06661>>06270000
                                                                        06275000
pcbpt := curprc;                                               <<06651>>06280000
if ics(-icspdisablecntcell) > 0 then                           <<02092>>06285000
   comment:  the purpose of the following code is to cover up  <<k7569>>06290000
             a pdisable problem in which an interrupt handler  <<k7569>>06295000
             appears to execute a pdisable without a           <<k7569>>06300000
             corresponding penable.  this strange problem      <<k7569>>06305000
             always appears to leave the pdisable count at 1.  <<k7569>>06310000
             if this condition is met, we shall execute a      <<k7569>>06315000
             penable on behalf of the defective software       <<k7569>>06320000
             [a small prayer is in order here] and continue    <<k7569>>06325000
             execution (soft'death will log this event). ;     <<k7569>>06330000
                                                               <<k7569>>06335000
   if ics(-icspdisablecntcell) = 1 then                        <<k7569>>06340000
      begin                                                    <<k7569>>06345000
      penable;  <<it's a miracle>>                             <<k7569>>06350000
      soft'death(634);                                         <<k7569>>06355000
      end                                                      <<k7569>>06360000
   else                                                        <<k7569>>06365000
      suddendeath(634);     <<leave the sf hook in>>           <<k7569>>06370000
forcestko;                                                              06375000
chek(errex,1);                                                 <<06636>>06380000
crit := setcritical;                                                    06385000
erroron;                                                                06390000
trapsoff;                                                               06395000
pinx := curprc;                                                <<06651>>06400000
                                                                        06405000
again:                                                                  06410000
                                                                        06415000
push(dl);                                                               06420000
dlval := tos;                                                           06425000
inx := stkinfo.stkdstfield&lsl(2);                             <<06651>>06430000
tos:=absolute(absolute(qi)-icsstkdstcell);                              06435000
stackdst := s0;                                                <<06661>>06440000
disable;                                                       <<02061>>06445000
getdatasegchangestate(*);                                               06450000
enable;                                                        <<02061>>06455000
if < then                                                               06460000
   begin       <<core res,locked or frozen>>                            06465000
   cc := ccl;                                                           06470000
   tos := dlval;                                                        06475000
   goto done;                                                           06480000
   end;                                                                 06485000
if > then go again;           <<it was impeded>>                        06490000
<<there is a pdisable in effect at this point>>                         06495000
cdb := setdbtostack;                                                    06500000
pxfixed; <<get ready to use pxfixed include file>>             <<06636>>06505000
if size >= 0 then                                              <<06636>>06510000
   begin                        <<reset to initial dl>>                 06515000
   if > then cc:=ccl;                                          <<06636>>06520000
   size := -pxfxdlreg;                                         <<06636>>06525000
   end;                                                                 06530000
sz := dsti'(inx).dsfld&lsl(2); <<segment size>>                         06535000
tos := dlval-size;                                                      06540000
if <= then                                                              06545000
   begin                        <<decrease dl area size>>               06550000
   tos:=-s0;                                                            06555000
   tos:=tos&lsr(pagepower);                                             06560000
   if = then                                                            06565000
       begin <<not at least a page release>>                            06570000
       tos:=dlval;                                                      06575000
       go to defrl;                                                     06580000
       end                                                              06585000
   else                                                                 06590000
       begin <<will contract now>>                                      06595000
       if gclassenabledmask.class0 then                                 06600000
          begin  <<measure db to dl contraction>>                       06605000
          tos:=measstatxdsbank;                                         06610000
          tos:=measstatxdsbase;                                         06615000
          tos:=tos+c0sub0'segreloff+c'dlcontract;              <<ray.v>>06620000
          asmb(lsea);                                                   06625000
          tos:=tos+1;                                                   06630000
          asmb(ssea;ddel);                                              06635000
          end;                                                          06640000
       relpagecnt:=s0;                                                  06645000
       relwordcnt:=s0&lsl(pagepower);                                   06650000
       dsti'(inx).dsfld:=(sz-relwordcnt)&lsr(2);                        06655000
       tos:=dst(inx+2); <<bank>>                                        06660000
       tos:=dst(x:=x+1);                                                06665000
       tos:=tos+sbtostkreldbdisp;                              <<06670>>06670000
       asmb(lsea);                                                      06675000
       tos:=tos-relwordcnt;                                             06680000
       asmb(ssea); <<new stack base relative db>>                       06685000
       tos:=tos+stkdbtostkdldisp;                                       06690000
       asmb(lsea); <<source for move>>                                  06695000
       rbrelsource := tos - 1;                                 <<02809>>06700000
       relinternalregion(relpagecnt,rbrelsource);                       06705000
       tos:=dlval+relwordcnt;                                           06710000
       duplicate;                                                       06715000
       f(f(qi)-7):=s0;                                                  06720000
       set(dl);                                                         06725000
       tos := mmstatspecreq;                                   <<*7596>>06730000
       tos := objident;                                        <<*7596>>06735000
       mmstat'(*,*,*,dlsize'contraction,size,0,0);             <<*7596>>06740000
       end;                                                             06745000
defrl:                                                                  06750000
    disable;                                                            06755000
    dsti'(inx).abit := 0;         <<mark present>>                      06760000
    enable;                                                             06765000
    goto done0;                                                         06770000
    end;                                                                06775000
                                                                        06780000
<<expand area if we get here>>                                          06785000
                                                                        06790000
<<round up request so that resultant stack will fit well>>              06795000
<<in a new region-i.e. minimal internal fragmentation>>                 06800000
                                                                        06805000
requestedinc:=tos;                                                      06810000
inc:=logical (requestedinc+127) land -128;                              06815000
newsz:=sz+inc;                                                          06820000
if newsz > integer(pxfxmaxstk) then                            <<06636>>06825000
   begin                                                                06830000
   cc:=ccg;                                                             06835000
   inc:=(pxfxmaxstk-logical(sz)) land -128;                    <<06636>>06840000
   if inc > 0 then newsz:=sz+inc else                                   06845000
      begin                                                             06850000
      cc:=ccg;                                                          06855000
      tos:=dlval;                                                       06860000
      goto defrl;                                                       06865000
      end;                                                              06870000
   end;                                                                 06875000
tos := logical(sz+inc+127) land -128;                                   06880000
duplicate;                                                              06885000
total := tos;                                                           06890000
if tos >= pxfxvirspace then                                    <<06636>>06895000
   begin   <<no vds>>                                                   06900000
   cc := ccl;                                                           06905000
   tos := dlval;                                                        06910000
   goto defrl;                                                          06915000
   end;                                                                 06920000
if gclassenabledmask.class0 then                                        06925000
   begin  <<measure db-dl expansion>>                                   06930000
   tos:=measstatxdsbank;                                                06935000
   tos:=measstatxdsbase;                                                06940000
   tos:=tos+c0sub0'segreloff+c'stopdlexpand;                   <<ray.v>>06945000
   asmb(lsea);                                                          06950000
   tos:=tos+1;                                                          06955000
   asmb(ssea;ddel);                                                     06960000
   end;                                                                 06965000
if gclassenabledmask.class15 then                              <<01813>>06970000
   begin <<process level seg (db-dl) expansion>>               <<01813>>06975000
   tos:=measprocxdsbank;                                       <<01813>>06980000
   tos:=measprocxdsbase;                                       <<01813>>06985000
   tos := tos + (curprc)/pcbsize*                              <<06651>>06990000
        class15'sub0size+cp'stopsegexpansion;                  <<01813>>06995000
   asmb(lsea);                                                 <<01813>>07000000
   tos:=tos+1;                                                 <<01813>>07005000
   asmb(ssea;ddel);                                            <<01813>>07010000
   end;                                                        <<01813>>07015000
<<stuff away reason stopped in pcbx of process>>               <<01813>>07020000
<<done unconditionally for history for meas interface>>        <<01813>>07025000
tos:=ics(-icsstkbankcell);                                     <<01813>>07030000
tos:=ics(-icsstkbasecell)+pxglobsize+measstopreason'idx;       <<01813>>07035000
tos:=stopsegfault;                                             <<01813>>07040000
asmb(ssea;ddel);                                               <<01813>>07045000
tos := objident;                                               <<06661>>07050000
tos := pcbpt;                                                  <<06651>>07055000
sendmsg(schedpin,makeabsentport,3,0);                          <<06661>>07060000
                                                                        07065000
<<fix pcbx ptrs>>                                                       07070000
                                                                        07075000
tos:=dst(x:=inx+2);                                                     07080000
tos:=dst(x:=x+1);                                                       07085000
tos:=tos+sbtostkdldisp;                                                 07090000
asmb(lsea);                                                             07095000
length:=tos; <<source for move>>                                        07100000
<<store away the info for the expansion>>                               07105000
genspecreq(objident,newsz&lsr(2),inc,length);                  <<06661>>07110000
tos:=tos+stkdltostkdbdisp;                                              07115000
asmb(lsea);                                                             07120000
tos:=tos+inc;                                                           07125000
asmb(ssea); <<new stack base relative db>>                              07130000
<<compute new-zdl and store in pxfixed if > prev max>>         <<01777>>07135000
push(z,dl);                                                    <<01777>>07140000
asmb(sub);                                                     <<01777>>07145000
tos:=tos+inc;                                                  <<01777>>07150000
if logical(s0) > pxfxcurmxstk then pxfxcurmxstk:=              <<06636>>07155000
   tos else asmb(del);                                         <<01777>>07160000
tos:=cdb;                                                               07165000
asmb(xchd;ddel);                                                        07170000
tos := mmstatspecreq;                                          <<*7596>>07175000
tos := objident;                                               <<*7596>>07180000
mmstat'(*,*,*,dlsize'expansion,size,0,0);                      <<*7596>>07185000
wait(memorywaitcode,memtrap);                                           07190000
push(dl);                                                               07195000
goto done;                                                              07200000
                                                                        07205000
done0:                                                                  07210000
                                                                        07215000
tos := cdb;                                                             07220000
asmb(xchd); ddel;                                                       07225000
penable;                                                                07230000
                                                                        07235000
done:                                                                   07240000
                                                                        07245000
dlsize := tos;                 <<return value>>                         07250000
resetcritical(crit);                                                    07255000
status.ccfld := cc;                                                     07260000
errorexit(errex,0,0);                                                   07265000
end <<dlsize>> ;                                                        07270000
                                                                        07275000
$page "SEGMENT EXPANSIONS/CONTRACTIONS : ZSIZE"                         07280000
comment  this function is called to expand or contract (z-db)           07285000
         size      =requested (z-db) size.                              07290000
         zsize     =granted (z-db) size.                                07295000
         code :    cc=0 o.k. zsize >= size.                             07300000
                   cc>0 o.k. zsize := max(z-db) < size.                 07305000
                   cc<0 failed. illegal size(size<(s-db)+128.  <<04609>>07310000
                        zsize := at least above min value.              07315000
         ;                                                              07320000
                                                                        07325000
integer procedure zsize(size);                                          07330000
value      size;                                                        07335000
integer    size;                                                        07340000
option     privileged;                                                  07345000
                                                                        07350000
begin                                                                   07355000
equate   errn      =136,                                                07360000
         exitn     =1,                                                  07365000
         errex     =[10/errn,6/exitn],                                  07370000
         extra     =1152,                                               07375000
         zcode     =4;                                                  07380000
integer  inx,minz,zval,sz,inc,maxinc,total,crit,lcsw,cc:=cce;           07385000
double   cdb;                                                           07390000
integer pcbpt;                                                 <<06651>>07395000
logical  ref;                                                           07400000
logical array qarray(*) = q+0;                                 <<06636>>07405000
logical pxfixedloc;                                            <<06636>>07410000
integer  new'z;                                                         07415000
integer pagesrequired,pagesallocated,stackdst;                 <<06661>>07420000
                                                               <<06661>>07425000
define                                                         <<06661>>07430000
   objident = double(stackdst)#;                               <<06661>>07435000
                                                               <<06661>>07440000
pcbpt := curprc;                                               <<06651>>07445000
if ics(-icspdisablecntcell) > 0 then                           <<02092>>07450000
   comment:  the purpose of the following code is to cover up  <<k7569>>07455000
             a pdisable problem in which an interrupt handler  <<k7569>>07460000
             appears to execute a pdisable without a           <<k7569>>07465000
             corresponding penable.  this strange problem      <<k7569>>07470000
             always appears to leave the pdisable count at 1.  <<k7569>>07475000
             if this condition is met, we shall execute a      <<k7569>>07480000
             penable on behalf of the defective software       <<k7569>>07485000
             [a small prayer is in order here] and continue    <<k7569>>07490000
             execution (soft'death will log this event). ;     <<k7569>>07495000
                                                               <<k7569>>07500000
   if ics(-icspdisablecntcell) = 1 then                        <<k7569>>07505000
      begin                                                    <<k7569>>07510000
      penable;  <<it's a miracle>>                             <<k7569>>07515000
      soft'death(634);                                         <<k7569>>07520000
      end                                                      <<k7569>>07525000
   else                                                        <<k7569>>07530000
      suddendeath(634);     <<leave the sf hook in>>           <<k7569>>07535000
forcestko;                                                              07540000
crit := setcritical;                                                    07545000
erroron;                                                                07550000
chek(errex,1);                                                          07555000
trapsoff;                                                               07560000
                                                                        07565000
again:                                                                  07570000
                                                                        07575000
inx := stkinfo.stkdstfield & lsl(2);                           <<06651>>07580000
stackdst := inx & lsr(2);                                      <<06661>>07585000
disable;                                                       <<02061>>07590000
getdatasegchangestate(stackdst);                               <<06661>>07595000
enable;                                                        <<02061>>07600000
if < then                                                               07605000
   begin                        <<core res,locked or frozen>>           07610000
   cc := ccl;                                                           07615000
   push(z);                                                             07620000
   goto done;                                                           07625000
   end;                                                                 07630000
if > then go again;           <<it was impeded>>                        07635000
<<there is a pdisable in effect at this point>>                         07640000
cdb := setdbtostack;                                                    07645000
pxfixed; <<init pxfixedloc to q-rel pxfixed table base>>       <<06636>>07650000
push(s,q,z);                                                            07655000
zval := tos;                                                            07660000
<<below: minz := (if s>q then s else q)+128>>                           07665000
asmb(ddup,lcmp);                                                        07670000
if > then exchange;                                                     07675000
minz := tos+128;                                                        07680000
del;                                                                    07685000
if size < minz then                                                     07690000
    begin                        <<select min allowed>>                 07695000
    size := minz;                                                       07700000
    cc := ccl;                                                          07705000
    end;                                                                07710000
sz := dsti'(inx).dsfld&lsl(2); <<segment size>>                         07715000
inc:=logical(size-zval+127) land -128;                         <<01695>>07720000
pagesrequired:=(inc+sz+overhead-1)&lsr(pagepower)+1;           <<01746>>07725000
disable;                                                                07730000
tos:=dsti'(inx+2); <<bank>>                                             07735000
tos:=dsti'(x:=x+1);                                                     07740000
tos:=tos+rbtorsdisp;                                                    07745000
asmb(lsea);                                                             07750000
pagesallocated:=tos;                                                    07755000
tos := size-zval;                                                       07760000
if inc <= 0 or pagesrequired <= pagesallocated then            <<01695>>07765000
   begin <<contract or current region big enough>>                      07770000
      if gclassenabledmask.class0 then                                  07775000
         begin  <<measure db-z contraction>>                            07780000
         tos:=measstatxdsbank;                                          07785000
         tos:=measstatxdsbase;                                          07790000
         tos:=tos+c0sub0'segreloff+c'dbzcontract;              <<ray.v>>07795000
         asmb(lsea);                                                    07800000
         tos:=tos+1;                                                    07805000
         asmb(ssea;ddel);                                               07810000
         end;                                                           07815000
   if size-zval < 0 and size-zval > -128 then                  <<01716>>07820000
         begin                      <<ignore>>                          07825000
         tos := zval;                                                   07830000
         go to done0;                                                   07835000
         end;                                                           07840000
   pxfxzreg := pxfxzreg+logical(inc);                          <<06636>>07845000
   tos := dsti'(inx);                                                   07850000
   tos := (sz+inc)&lsr(2);                                              07855000
   tos.dsfld := tos;            <<new size in desc>>                    07860000
   dsti'(x) := tos;             <<update desc>>                         07865000
   tos := zval+inc; duplicate;                                          07870000
   f(x) := f(f(qi)-8)+inc;      <<z>>                                   07875000
   set(z);                                                              07880000
   tos := mmstatspecreq;                                       <<*7596>>07885000
   tos := objident;                                            <<*7596>>07890000
   mmstat'(*,*,*,zsize'contraction,size,0,0);                  <<*7596>>07895000
   goto done0;                                                          07900000
   end;                                                                 07905000
<<we must expand the (z-db) area if we arrive here>>                    07910000
tos := pxfxmaxstk-logical(sz);                                 <<06636>>07915000
tos:=tos land -128;                                            <<01695>>07920000
if <= then                                                              07925000
   begin                        <<exceptional case>>                    07930000
   del;                                                                 07935000
   cc := ccg;                                                           07940000
   tos := zval;                                                         07945000
   go to done0;                                                         07950000
   end;                                                                 07955000
if s0 >= inc then assemble(del) else                                    07960000
   begin                                                                07965000
   cc:=ccg;                                                             07970000
   inc:=tos;                                                            07975000
   end;                                                                 07980000
if (logical(127+sz+inc) land -128)>=pxfxvirspace then          <<06636>>07985000
   begin                        <<expand vds>>                          07990000
   cc:=ccl;                                                             07995000
   tos:=zval;                                                           08000000
   go to done0;                                                         08005000
   end;                                                                 08010000
if gclassenabledmask.class0 then                                        08015000
   begin  <<measure db-z expansion>>                                    08020000
   tos:=measstatxdsbank;                                                08025000
   tos:=measstatxdsbase;                                                08030000
   tos:=tos+c0sub0'segreloff+c'stopdbzexpand;                  <<ray.v>>08035000
   asmb(lsea);                                                          08040000
   tos:=tos+1;                                                          08045000
   asmb(ssea;ddel);                                                     08050000
   end;                                                                 08055000
if gclassenabledmask.class15 then                              <<01813>>08060000
   begin <<process level seg (db-z) expansion>>                <<01813>>08065000
   tos:=measprocxdsbank;                                       <<01813>>08070000
   tos:=measprocxdsbase;                                       <<01813>>08075000
   tos := tos + (curprc)/pcbsize*                              <<06651>>08080000
        class15'sub0size+cp'stopsegexpansion;                  <<01813>>08085000
   asmb(lsea);                                                 <<01813>>08090000
   tos:=tos+1;                                                 <<01813>>08095000
   asmb(ssea;ddel);                                            <<01813>>08100000
   end;                                                        <<01813>>08105000
<<stuff away reason stopped in pcbx of process>>               <<01813>>08110000
<<done unconditionally for history for meas interface>>        <<01813>>08115000
tos:=ics(-icsstkbankcell);                                     <<01813>>08120000
tos:=ics(-icsstkbasecell)+pxglobsize+measstopreason'idx;       <<01813>>08125000
tos:=stopsegfault;                                             <<01813>>08130000
asmb(ssea;ddel);                                               <<01813>>08135000
new'z := pxfxzreg+logical(inc);                                <<06636>>08140000
tos:=cdb;                                                               08145000
asmb(xchd;ddel);                                                        08150000
<<store away the info for the expansion>>                               08155000
                                                                        08160000
genspecreq(objident,(sz+inc)&lsr(2),0,0);                      <<06661>>08165000
                                                                        08170000
tos := objident;                                               <<06661>>08175000
tos := curprc;                                                 <<06651>>08180000
sendmsg(schedpin,makeabsentport,3,0);                          <<06661>>08185000
tos := mmstatspecreq;                                          <<*7596>>08190000
tos := objident;                                               <<*7596>>08195000
mmstat'(*,*,*,zsize'expansion,size,0,0);                       <<*7596>>08200000
wait(memorywaitcode,memtrap);                                           08205000
<< request granted; adjust z to new z value >>                          08210000
pdisable;                                                               08215000
cdb:= setdbtostack;                                                     08220000
tos:=new'z;                                                             08225000
assemble(dup,dup;                                                       08230000
         dup   );                                                       08235000
pxfxzreg:=tos;                                                 <<06636>>08240000
ics'global'z:=tos;                                                      08245000
set(z);                                                                 08250000
<<compute new z-dl and store in pxfixed if > prev max>>        <<01777>>08255000
push(z,dl);                                                    <<01777>>08260000
asmb(sub);                                                     <<01777>>08265000
if logical(s0) > pxfxcurmxstk then pxfxcurmxstk:=              <<06636>>08270000
   tos else asmb(del);                                         <<01777>>08275000
<< note, there is still one new'z on tos >>                             08280000
                                                                        08285000
done0:                                                                  08290000
                                                                        08295000
tos := cdb;                                                             08300000
asmb(xchd); ddel;                                                       08305000
dsti'(inx).absentflag:=0;                                               08310000
penable;                                                                08315000
                                                                        08320000
done:                                                                   08325000
                                                                        08330000
zsize := tos;                  <<return size to caller>>                08335000
resetcritical(crit);                                                    08340000
status.ccfld := cc;                                                     08345000
errorexit(errex,0,0);                                                   08350000
end <<zsize>> ;                                                         08355000
                                                                        08360000
$page "SEGMENT EXPANSIONS/CONTRACTIONS : ALT PX FILE SIZE"              08365000
                                                                        08370000
comment  this procedure is called by the file system to expand          08375000
         contract the pxfile area in the pcbx. inc is the chang         08380000
         in size required. inc will be rounded up to an integra         08385000
         multiple of 128 words. for example, if the request is          08390000
         to expand the area by less than 128 words, the area            08395000
         will be increased by 128 words. if the request was to          08400000
         reduce the area by less than 128 words, the area size          08405000
         will remain the same.                                          08410000
         ;                                                              08415000
                                                                        08420000
integer procedure altpxfilesize(inc);                                   08425000
value      inc;                                                         08430000
integer    inc;                                                         08435000
option     uncallable,privileged;                                       08440000
                                                                        08445000
begin                                                                   08450000
integer  pointer   pdl,           <<pointer to dl base>>                08455000
                   pcbx,          <<pointer to pcbx base>>              08460000
                   pxfile;        <<pointer to pxfile base>>            08465000
integer relpagecnt,relwordcnt,wordsrequired,pagesrequired,              08470000
        requestedinc,newsz,rbrelsource,oldstkdl,                        08475000
        olddltopxfiledisp,source;                                       08480000
logical array qarray(*) = q+0;                                 <<06636>>08485000
logical pxfixedloc;                                            <<06636>>08490000
integer  inx,sz,total,maxinc,ml,crit,lcsw,stackdst;            <<06661>>08495000
                                                               <<06661>>08500000
define                                                         <<06661>>08505000
   objident = double(stackdst)#;                               <<06661>>08510000
                                                               <<06661>>08515000
double   cdb;                                                           08520000
logical  ref;                                                           08525000
integer pcbpt;                                                 <<06651>>08530000
equate   pxfilecode=8,                                                  08535000
         extra     =1152;                                               08540000
                                                                        08545000
subroutine setpointers;                                                 08550000
                                                                        08555000
begin                                                                   08560000
cdb := setdbtostack;                                                    08565000
@pcbx := @pdl(-pdl(-1));                                                08570000
pxfixed; <<get ready to use pxfixed include file>>             <<06636>>08575000
@pxfile := @pdl(-pdl(-3));                                              08580000
end <<setpointers>> ;                                                   08585000
                                                                        08590000
subroutine changeall;                                                   08595000
                                                                        08600000
begin                                                                   08605000
tos := inc; duplicate;                                                  08610000
pxfile := tos+pxfile;          <<d-c>>                                  08615000
duplicate;                                                              08620000
pcbx := tos+pcbx;              <<dl-a>>                                 08625000
duplicate;                                                              08630000
pdl(x) := tos+pdl(-1);         <<dl-a>>                                 08635000
duplicate;                                                              08640000
pdl(x) := tos+pdl(-2);         <<dl-b>>                                 08645000
duplicate;                                                              08650000
pdl(x) := tos+pdl(-3);         <<dl-c>>                                 08655000
<< check to insure resultant maxdata not too big >>                     08660000
tos := tos+pxfxmaxstk;                                         <<06636>>08665000
tos := stack'limit;                                                     08670000
asmb(ddup,cmp);                                                         08675000
if > then asmb(xch);                                                    08680000
del;                                                                    08685000
pxfxmaxstk := tos;                                             <<06636>>08690000
end <<changeall>> ;                                                     08695000
                                                                        08700000
pcbpt := curprc;                                               <<06651>>08705000
if ics(-icspdisablecntcell) > 0 then                           <<02092>>08710000
   comment:  the purpose of the following code is to cover up  <<k7569>>08715000
             a pdisable problem in which an interrupt handler  <<k7569>>08720000
             appears to execute a pdisable without a           <<k7569>>08725000
             corresponding penable.  this strange problem      <<k7569>>08730000
             always appears to leave the pdisable count at 1.  <<k7569>>08735000
             if this condition is met, we shall execute a      <<k7569>>08740000
             penable on behalf of the defective software       <<k7569>>08745000
             [a small prayer is in order here] and continue    <<k7569>>08750000
             execution (soft'death will log this event). ;     <<k7569>>08755000
                                                               <<k7569>>08760000
   if ics(-icspdisablecntcell) = 1 then                        <<k7569>>08765000
      begin                                                    <<k7569>>08770000
      penable;  <<it's a miracle>>                             <<k7569>>08775000
      soft'death(634);                                         <<k7569>>08780000
      end                                                      <<k7569>>08785000
   else                                                        <<k7569>>08790000
      suddendeath(634);     <<leave the sf hook in>>           <<k7569>>08795000
altpxfilesize := 0;                                                     08800000
forcestko;                                                              08805000
trapsoff;                                                               08810000
crit := setcritical;                                                    08815000
                                                                        08820000
again:                                                                  08825000
                                                                        08830000
push(dl);                                                               08835000
@pdl := tos;                                                            08840000
inx := stkinfo.stkdstfield&lsl(2);                             <<06651>>08845000
tos:=absolute(absolute(qi)-icsstkdstcell);                              08850000
stackdst := s0;                                                <<06661>>08855000
disable;                                                       <<02061>>08860000
getdatasegchangestate(*);                                               08865000
enable;                                                        <<02061>>08870000
if < then                                                               08875000
   begin                        <<core res,locked or frozen>>           08880000
                                                                        08885000
   errorl:                                                              08890000
                                                                        08895000
   altpxfilesize := 1;                                                  08900000
   goto fin;                                                            08905000
   end;                                                                 08910000
if > then go again;           <<it was impeded>>                        08915000
<<there is a pdisable in effect at this point>>                         08920000
setpointers;                                                            08925000
sz := dsti'(inx).dsfld&lsl(2); <<segment size>>                         08930000
tos := inc;                    <<change value>>                         08935000
if <= then                                                              08940000
   begin                        <<contract pxfile area>>                08945000
   tos:=-s0;                                                            08950000
   tos:=tos&lsr(pagepower);                                             08955000
   if = then                                                            08960000
      begin <<not at least a page release>>                             08965000
      go to defrl;                                                      08970000
      end                                                               08975000
   else                                                                 08980000
      begin <<will contract now>>                                       08985000
      tos := mmstatspecreq;                                    <<*7596>>08990000
      tos := objident;                                         <<*7596>>08995000
      mmstat'(*,*,*,pxfile'contraction,inc,0,0);               <<*7596>>09000000
      if gclassenabledmask.class0 then                                  09005000
         begin  <<measure pxfile contraction event>>                    09010000
         tos:=measstatxdsbank;                                          09015000
         tos:=measstatxdsbase;                                          09020000
         tos:=tos+c0sub0'segreloff+c'pxfilecontract;           <<ray.v>>09025000
         asmb(lsea);                                                    09030000
         tos:=tos+1;                                                    09035000
         asmb(ssea;ddel);                                               09040000
         end;                                                           09045000
      relpagecnt:=s0;                                                   09050000
      relwordcnt:=s0&lsl(pagepower);                                    09055000
      inc:=-relwordcnt;                                                 09060000
      if (pxfile+inc) < 0 then                                          09065000
         begin                                                          09070000
         altpxfilesize := 1;                                            09075000
         goto defrl;                                                    09080000
         end;                                                           09085000
      tos:=dst(inx+2); <<bank>>                                         09090000
      tos:=dst(x:=x+1);                                                 09095000
      tos:=tos+sbtostkreldbdisp;                               <<06670>>09100000
      asmb(lsea);                                                       09105000
      tos:=tos-relwordcnt;                                              09110000
      asmb(ssea); <<new stack base relative db>>                        09115000
      tos:=tos+stkdbtostkdldisp;                                        09120000
      oldstkdl:=s0;                                                     09125000
      asmb(lsea);                                                       09130000
      tos:=tos-relwordcnt;                                              09135000
      asmb(ssea);  <<new stk rel dl>>                                   09140000
      tos:=tos+stkdltosbdisp+oldstkdl-1;                                09145000
      asmb(lsea); <<dl-a>>                                              09150000
      tos:=tos-relwordcnt;                                              09155000
      asmb(ssea);                                                       09160000
      tos:=tos-1;                                                       09165000
      asmb(lsea);                                                       09170000
      tos:=tos-relwordcnt;                                              09175000
      asmb(ssea);                                                       09180000
      tos:=tos-1;                                                       09185000
      asmb(lsea);                                                       09190000
      olddltopxfiledisp:=s0;                                            09195000
      tos:=tos-relwordcnt;                                              09200000
      asmb(ssea);                                                       09205000
      tos:=tos+3;                                                       09210000
      tos:=tos+3-olddltopxfiledisp;                                     09215000
      asmb(lsea);                                                       09220000
      tos:=tos-relwordcnt; <<new pxfile length>>                        09225000
      if < then suddendeath(633);                              <<01636>>09230000
      rbrelsource:=oldstkdl-olddltopxfiledisp+s0;                       09235000
      relinternalregion(relpagecnt,rbrelsource);                        09240000
                                                                        09245000
      defrl :                                                           09250000
                                                                        09255000
      disable;                                                          09260000
      dsti'(inx).abit := 0;        <<mark present>>                     09265000
      enable;                                                           09270000
      go quit;                                                          09275000
      end;                                                              09280000
   end;                                                                 09285000
                                                                        09290000
<<expand pxfile area>>                                                  09295000
<<round up request so that resultant stack will fit well>>              09300000
<<in a new region-i.e. minimal internal fragmentation>>                 09305000
                                                                        09310000
requestedinc:=tos;                                                      09315000
newsz:=sz+inc;                                                          09320000
if newsz > stack'limit then                                             09325000
   begin                                                                09330000
   altpxfilesize:=2;                                                    09335000
   go to defrl;                                                         09340000
   end;                                                                 09345000
tos:=logical(sz+inc+127) land -128;                                     09350000
if tos >= pxfxvirspace then                                    <<06636>>09355000
   begin                        <<must expand vds>>                     09360000
   altpxfilesize := 3;                                                  09365000
   goto defrl;                                                          09370000
   end;                                                                 09375000
if gclassenabledmask.class0 then                                        09380000
   begin  <<measure pxfile exp event>>                                  09385000
   tos:=measstatxdsbank;                                                09390000
   tos:=measstatxdsbase;                                                09395000
   tos:=tos+c0sub0'segreloff+c'stoppxfileexpand;               <<ray.v>>09400000
   asmb(lsea);                                                          09405000
   tos:=tos+1;                                                          09410000
   asmb(ssea;ddel);                                                     09415000
   end;                                                                 09420000
if gclassenabledmask.class15 then                              <<01813>>09425000
   begin <<process level seg (pxfile) expansion>>              <<01813>>09430000
   tos:=measprocxdsbank;                                       <<01813>>09435000
   tos:=measprocxdsbase;                                       <<01813>>09440000
   tos := tos + (curprc)/pcbsize*                              <<06651>>09445000
        class15'sub0size+cp'stopsegexpansion;                  <<01813>>09450000
   asmb(lsea);                                                 <<01813>>09455000
   tos:=tos+1;                                                 <<01813>>09460000
   asmb(ssea;ddel);                                            <<01813>>09465000
   end;                                                        <<01813>>09470000
<<stuff away reason stopped in pcbx of process>>               <<01813>>09475000
<<done unconditionally for history for meas interface>>        <<01813>>09480000
tos:=ics(-icsstkbankcell);                                     <<01813>>09485000
tos:=ics(-icsstkbasecell)+pxglobsize+measstopreason'idx;       <<01813>>09490000
tos:=stopsegfault;                                             <<01813>>09495000
asmb(ssea;ddel);                                               <<01813>>09500000
<<fix pcbx ptrs>>                                                       09505000
                                                                        09510000
tos:=dst(x:=inx+2);                                                     09515000
tos:=dst(x:=x+1);                                                       09520000
tos:=tos+sbtostkreldbdisp;                                     <<06670>>09525000
asmb(lsea);                                                             09530000
tos:=tos+inc;                                                           09535000
asmb(ssea); <<new stack base relative db>>                              09540000
tos:=tos+stkdbtostkdldisp;                                              09545000
asmb(lsea);                                                             09550000
source:=s0+pxfile-pdl(-3);                                              09555000
<<store away the info for the expansion>>                               09560000
                                                                        09565000
genspecreq(objident,newsz&lsr(2),inc,source);                  <<06661>>09570000
                                                                        09575000
changeall;                                                              09580000
tos:=cdb;                                                               09585000
asmb(xchd;ddel);                                                        09590000
tos := objident;                                               <<06661>>09595000
tos := curprc;                                                 <<06651>>09600000
sendmsg(schedpin,makeabsentport,3,0);                          <<06661>>09605000
tos := mmstatspecreq;                                          <<*7596>>09610000
tos := objident;                                               <<*7596>>09615000
mmstat'(*,*,*,pxfile'expansion,inc,0,0);                       <<*7596>>09620000
wait(memorywaitcode,memtrap);                                           09625000
go fin;                                                                 09630000
                                                                        09635000
                                                                        09640000
quit:                                                                   09645000
                                                                        09650000
tos := cdb;                                                             09655000
asmb(xchd); ddel;                                                       09660000
penable;                                                                09665000
                                                                        09670000
fin:                                                                    09675000
                                                                        09680000
resetcritical(crit);                                                    09685000
if ics(-icspdisablecntcell) > 0 then                           <<02092>>09690000
   comment:  the purpose of the following code is to cover up  <<k7569>>09695000
             a pdisable problem in which an interrupt handler  <<k7569>>09700000
             appears to execute a pdisable without a           <<k7569>>09705000
             corresponding penable.  this strange problem      <<k7569>>09710000
             always appears to leave the pdisable count at 1.  <<k7569>>09715000
             if this condition is met, we shall execute a      <<k7569>>09720000
             penable on behalf of the defective software       <<k7569>>09725000
             [a small prayer is in order here] and continue    <<k7569>>09730000
             execution (soft'death will log this event). ;     <<k7569>>09735000
                                                               <<k7569>>09740000
   if ics(-icspdisablecntcell) = 1 then                        <<k7569>>09745000
      begin                                                    <<k7569>>09750000
      penable;  <<it's a miracle>>                             <<k7569>>09755000
      soft'death(634);                                         <<k7569>>09760000
      end                                                      <<k7569>>09765000
   else                                                        <<k7569>>09770000
      suddendeath(634);     <<leave the sf hook in>>           <<k7569>>09775000
end <<altpxfilesize>> ;                                                 09780000
$page "SEGMENT EXPANSIONS/CONTRACTIONS : MAPCHANGE"                     09785000
<<***************************************************************>>     09790000
                                                                        09795000
                                                               <<06636>>09800000
procedure changemap(bitarray,bitnumber,size,flag);             <<06636>>09805000
   <<sets/resets bit specified by bitnumber in the bit array>> <<06636>>09810000
   <<specified by bitarray>>                                   <<06636>>09815000
   value flag,bitnumber;                                       <<06636>>09820000
   logical flag;  <<true=set bit,  false=reset bit>>           <<06636>>09825000
   logical array bitarray;                                     <<07322>>09830000
   integer bitnumber,size;                                     <<06636>>09835000
   option privileged,uncallable;                               <<*7863>>09840000
   begin                                                       <<06636>>09845000
      integer index;                                           <<06636>>09850000
      while size  > 0 do                                       <<06636>>09855000
      begin                                                    <<06636>>09860000
      index:=bitnumber.(0:12);                                 <<06636>>09865000
      tos:=bitarray(index);                                    <<07322>>09870000
      x:=bitnumber.(12:4);                                     <<06636>>09875000
      if flag                                                  <<06636>>09880000
         then asmb(tsbc 0,x)                                   <<06636>>09885000
         else asmb(trbc 0,x);                                  <<06636>>09890000
      bitarray(index):=tos;                                    <<07322>>09895000
      bitnumber:=bitnumber + 1;                                <<06636>>09900000
      size:=size-1;                                            <<06636>>09905000
      end;                                                     <<06636>>09910000
   end;                                                        <<06636>>09915000
$page "SEGMENT EXPANSIONS/CONTRACTIONS : RELEASE PX SEG"                09920000
<<***************************************************************>>     09925000
                                                                        09930000
comment  release pcbx(pxfixed), data segment space;                     09935000
procedure relpxseg(l,size);                                             09940000
   value      l,size;                                                   09945000
   integer    l,size;                                                   09950000
   option     uncallable,privileged;                                    09955000
   begin                                                                09960000
      logical index;                                           <<06636>>09965000
      logical array qarray(*) = q+0;                           <<06636>>09970000
      logical pxfixedloc;                                      <<06636>>09975000
         size := (size+7)&lsr(3);       <<bit count>>                   09980000
         pdisable;                                                      09985000
         pxfixed; <<get ready to use pxfixed include file>>    <<06636>>09990000
         index:=0;                                             <<06636>>09995000
         changemap(pxfxbitmap,(l-pxmap-4)&lsr(3),size,1);      <<07322>>10000000
         qarray(pxfixedloc+logical(l))   := 0;                 <<06636>>10005000
         move qarray(pxfixedloc+logical(l)+1) :=               <<06636>>10010000
           qarray(pxfixedloc+logical(l)),(size&lsl(3)-1);      <<06636>>10015000
         penable;                                                       10020000
   end <<relpxseg>> ;                                                   10025000
$page "SEGMENT EXPANSIONS/CONTRACTIONS : GET PX SEG"                    10030000
<<***************************************************************>>     10035000
                                                                        10040000
comment  get pcbx(pxfixed) data segment space;                          10045000
logical procedure getpxseg(size);                                       10050000
   value      size;                                                     10055000
   integer    size;                                                     10060000
   option     uncallable,privileged;                                    10065000
   begin                                                                10070000
     integer  max,v,sb,b,inx,crit;                             <<06636>>10075000
      integer pcbpt;                                           <<06651>>10080000
     logical index;                                            <<06636>>10085000
     integer oldsize,newsize;                                           10090000
     logical array qarray(*) = q+0;                            <<06636>>10095000
     logical pxfixedloc;                                       <<06636>>10100000
     integer  pointer                                                   10105000
              pdl;                     <<pointer to dl>>       <<06636>>10110000
    integer   stackdst;                                        <<06661>>10115000
                                                               <<06661>>10120000
define                                                         <<06661>>10125000
   objident = double(stackdst)#;                               <<06661>>10130000
                                                               <<06661>>10135000
   equate     pxfecode  =7;                                    <<06636>>10140000
                                                               <<06661>>10145000
                                                               <<06661>>10150000
         size := (size+7)&lsr(3);       <<no. of bits>>                 10155000
         crit := setcritical;                                           10160000
          pcbpt := curprc;                                     <<06651>>10165000
         forcestko;                                                     10170000
                                                               <<06661>>10175000
start  : pdisable;                                                      10180000
         push(dl);                                                      10185000
         @pdl := tos;                                                   10190000
         pxfixed; <<get ready to use pxfixed include file>>    <<06636>>10195000
scanl  : max := pdl(-4)&lsl(4);        <<expansion area size>>          10200000
         sb := b := v := 0;                                             10205000
again  : tos := b; duplicate;                                           10210000
         index:=tos&lsr(4);                                    <<06636>>10215000
         tos := pxfxbitmap;       <<word with bit>>            <<06636>>10220000
         exchange;                                                      10225000
         x := tos.(12:4);              <<bit position>>                 10230000
         asmb(tbc 0,x); del;                                            10235000
         if <> then                                                     10240000
          begin                       <<on>>                            10245000
           if (v:=v+1) = size then                                      10250000
            goto foundl;                                                10255000
          end                                                           10260000
         else                                                           10265000
          begin                       <<off>>                           10270000
           sb := b+1;                                                   10275000
           v := 0;                                                      10280000
          end;                                                          10285000
         if (b:=b+1) >= max then                                        10290000
          begin <<fails>>                                      <<00.06>>10295000
           index:=max&lsr(4);                                  <<06636>>10300000
           pxfxbitmap := -1;      <<init the map>>             <<06636>>10305000
           penable;                                            <<00.06>>10310000
           go to expandl;              <<get more space>>      <<00.06>>10315000
          end;                                                 <<00.06>>10320000
         go again;                                                      10325000
foundl : <<located space if we get here>>                               10330000
         getpxseg := sb&lsl(3)+pxmap+4;                                 10335000
           index:=0;                                           <<06636>>10340000
         changemap(pxfxbitmap,sb,size,0);    <<reset bits>>    <<06636>>10345000
         go quit;                                                       10350000
expandl: <<must physically expand area if we get here>>                 10355000
         if pdl(-4) >= 3 then   <<3 is limit>>               <<01.02>>  10360000
           begin                                             <<01.02>>  10365000
             getpxseg:=-1;                                   <<01.02>>  10370000
             go to quit1;                                    <<01.02>>  10375000
           end;                                              <<01.02>>  10380000
          inx := stkinfo.stkdstfield&lsl(2);                   <<06651>>10385000
         stackdst := inx & lsr(2);                             <<06661>>10390000
         oldsize:=(dst(inx).datasizefield)&lsl(2);                      10395000
         newsize:=oldsize+128;                                          10400000
         disable;                                              <<02061>>10405000
         getdatasegchangestate(stackdst);                      <<06661>>10410000
         enable;                                               <<02061>>10415000
         if < then     << c. res, locked, or frozen >>         <<00593>>10420000
           begin                                               <<00593>>10425000
             getpxseg := 0;                                    <<00593>>10430000
             goto quit1;                                       <<00593>>10435000
           end;                                                <<00593>>10440000
         if > then goto expandl;      <<it was impeded>>                10445000
         <<there is a pdisable in effect at this point>>                10450000
         max := pdl(-1)-pdl(-3);      <<c-a>>                           10455000
                                                                        10460000
<<store away the info for the expansion>>                               10465000
                                                                        10470000
genspecreq(objident,newsize&lsr(2),128,max);                   <<06661>>10475000
                                                                        10480000
                                                                        10485000
         <<fix pcbx ptrs>>                                              10490000
                                                                        10495000
         tos:=dst(x:=inx+2);                                            10500000
         tos:=dst(x:=x+1);                                              10505000
         tos:=tos+sbtostkreldbdisp;                            <<06670>>10510000
         asmb(lsea);                                                    10515000
         tos:=tos+128;                                                  10520000
         asmb(ssea); <<new stack base relative db>>                     10525000
         tos:=tos+stkdbtostkdldisp;                                     10530000
         asmb(lsea);                                                    10535000
         tos:=tos+128;                                                  10540000
         asmb(ssea);                                                    10545000
         tos:=tos+stkdltopxfixeddisp;                                   10550000
         asmb(lsea);                                                    10555000
         tos:=tos+128;                                                  10560000
         asmb(ssea);                                                    10565000
         pdl(-1):=pdl(-1)+128;                                          10570000
         pdl(-2):=pdl(-2)+128;                                          10575000
         pdl(-4):=pdl(-4)+1; <<#sectors>>                               10580000
                                                                        10585000
         <<send scheduler a message to get rid of stack>>               10590000
                                                                        10595000
         tos := objident;                                      <<06661>>10600000
          tos := curprc;                                       <<06651>>10605000
         sendmsg(schedpin,makeabsentport,3,0);                 <<06661>>10610000
                                                                        10615000
         <<wait on a memory wait, then start over>>                     10620000
                                                                        10625000
         tos := mmstatspecreq;                                 <<*7596>>10630000
         tos := objident;                                      <<*7596>>10635000
         mmstat'(*,*,*,pxfixed'expansion,size,0,0);            <<*7596>>10640000
         wait(memorywaitcode,memtrap);                                  10645000
         goto start;                                                    10650000
quit   : penable;                                                       10655000
quit1  : resetcritical(crit);                                  <<00.06>>10660000
   end <<getpxseg>> ;                                                   10665000
$page "PROCESS EXTRA DATA SEGMENT MANAGEMENT"                           10670000
<<***************************************************************>>     10675000
                                                                        10680000
                                                                        10685000
                                                                        10690000
            << >>                                                       10695000
            <<extra dst manipulation in pcbx                            10700000
               - 0   get entry                                          10705000
               - 1   release entry                                      10710000
               - 2   extract entry contents                             10715000
               - 3   search,validate,and return index                   10720000
               - 4   search,validate,and return dst#                    10725000
               - 5   return next entry and release                      10730000
               - 6   check entry using dst#                             10735000
               - 7   extract complete entry contents             c+.09  10740000
               - n   insert entry contents     >>                       10745000
            << >>                                                       10750000
logical procedure pxdseg(func,parm);                                    10755000
  value   func,parm;                                                    10760000
  logical func,parm;                                                    10765000
  option  privileged,uncallable;                                        10770000
  begin                                                                 10775000
          << >>                                                         10780000
          equate     pxdst=7,                                           10785000
                     pxdsz=8,                                           10790000
                     pxdsm =pxdsz - 1;                         <<00.06>>10795000
          define     linkf =(0:12)#,                                    10800000
                     countf=(12:4)#,                                    10805000
                     typef =(0:2)#,                                     10810000
                     indexf=(2:14)#,                                    10815000
                     npmax =f(%1112)#,                         <<00.06>>10820000
                     crapf =(0:6)#;                                     10825000
          integer array stak(*)=q+0;                                    10830000
          integer pointer pbase,p;                                      10835000
          logical priv,flag;                                            10840000
          integer l,i,m,d,dx,ix;                                        10845000
          switch sw:= l0,                                               10850000
                     l1,                                                10855000
                     l2,                                                10860000
                     l3,                                                10865000
                     l3,                                                10870000
                     l5,                                                10875000
                     l6,                                       <<c+.09>>10880000
                     l2;                                       <<c+.09>>10885000
          << >>                                                         10890000
  subroutine setup;                                                     10895000
    begin                                                               10900000
          push(dl);                                                     10905000
          @p:=tos;                                                      10910000
          @pbase:=@p-p(-2);                                             10915000
          @p:=@pbase(pxdst);                                            10920000
    end;                                                                10925000
          << >>                                                         10930000
  logical subroutine bump;                                              10935000
    begin                                                               10940000
          l:=l-p.countf;                                                10945000
          if p.linkf=0 then return;                                     10950000
          @p:=@pbase+p.linkf;                                           10955000
          bump:=true;                                                   10960000
    end;                                                                10965000
          << >>                                                         10970000
  logical subroutine point(ix);                                         10975000
    value   ix;                                                         10980000
    integer ix;                                                         10985000
    begin                                                               10990000
          l:=ix.indexf;                                                 10995000
          while l>p.countf do                                           11000000
               if not bump then return;                                 11005000
          @p:=@p(l);                                                    11010000
          point:=true;                                                  11015000
    end;                                                                11020000
          << >>                                                         11025000
  logical subroutine xcan(dx);                                          11030000
    value   dx;                                                         11035000
    integer dx;                                                         11040000
    begin                                                               11045000
          l:=0;                                                         11050000
          m:=0;                                                         11055000
    scn:  i:=0;                                                         11060000
          while (i:=i+1)<=p.countf do                                   11065000
               begin if dx=-1 then if p(i)<>0 then goto scl;            11070000
                     if logical(p(i).privf) then m:=m+1;                11075000
                     if dx=p(i).dsegf then goto scl;                    11080000
               end;                                                     11085000
          if bump then goto scn else return;                            11090000
    scl:  @p:=@p(i);                                                    11095000
          tos:=p;                                                       11100000
          tos.indexf:=i-l;                                              11105000
          l:=tos;                                                       11110000
          xcan:=true;                                                   11115000
    end;                                                                11120000
          << >>                                                         11125000
          priv:=stak(-stak-1).privf;                                    11130000
          setup;                                                        11135000
          goto sw(func);                                                11140000
          goto ln;                                                      11145000
  l0:     flag:=xcan(0);                                                11150000
          if not priv then if m=npmax then goto zero;                   11155000
          if flag then                                                  11160000
               begin tos:=l;                                            11165000
                     if not priv then tos.privf:=1;                     11170000
                     goto fin;                                          11175000
               end;                                                     11180000
          d:=@p-@pbase;                                                 11185000
          dx:=getpxseg(pxdsz);                                          11190000
          if dx < 0 then goto zero                             <<00593>>11195000
          else if dx = 0 then                                  <<00593>>11200000
            begin  << stack was frozen >>                      <<00593>>11205000
              tos := -1;                                       <<00593>>11210000
              goto fin;                                        <<00593>>11215000
            end;                                               <<00593>>11220000
          setup;                                                        11225000
          pbase(d).linkf:=dx;                                           11230000
          pbase(dx) := pxdsm;  <<set count in first word>>     <<00.06>>11235000
          pbase(dx+1) := 0;     <<clear next word>>            <<00.06>>11240000
          move pbase(dx+2) := pbase(dx+1),(pxdsm-1); <<clear>> <<00.06>>11245000
          goto l0;                                                      11250000
  l1:     if point(parm) then p:=0;                                     11255000
          goto zero;                                                    11260000
  l2:     if not point(parm) then goto zero;                            11265000
          tos:=p.dsegf;                                                 11270000
          if func=2 then go to fin;                            <<c+.09>>11275000
          if tos=0 then tos := 1   << 1 means empty. >>        <<c+.09>>11280000
                   else tos := p;  << complete contents >>     <<c+.09>>11285000
          goto fin;                                                     11290000
  l3:     if parm.privf = 1 then goto zero;                    <<00626>>11295000
           if parm.crapf <> 0 and not priv                     <<07322>>11300000
               then begin ix:=-integer(parm);                           11305000
                          if not point(ix) then goto zero;              11310000
                          if ix.typef<>p.typef then goto zero;          11315000
                    end                                                 11320000
              else begin if not priv then goto zero;                    11325000
                          if not xcan(parm) then goto zero;             11330000
                          ix:=l;                                        11335000
                    end;                                                11340000
          if func=3                                                     11345000
               then  tos:=ix                                            11350000
               else  tos:=p.dsegf;                                      11355000
          goto fin;                                                     11360000
  l5:     if not xcan(-1) then goto zero;                               11365000
          tos:=p;                                                       11370000
          p:=0;                                                         11375000
          goto fin;                                                     11380000
  l6:     if not xcan(parm) then goto zero;                             11385000
          if logical(l).privf                                           11390000
               then tos:=-l                                             11395000
               else tos:=parm;                                          11400000
          goto fin;                                                     11405000
  ln:     if not point(parm) then goto zero;                            11410000
          tos:=parm;                                                    11415000
          tos.indexf:=func;                                             11420000
          p:=tos;                                                       11425000
          if parm.privf                                                 11430000
               then  tos:=-integer(parm)                                11435000
               else  tos:=func;                                         11440000
          goto fin;                                                     11445000
  zero:   tos:=0;                                                       11450000
  fin:    pxdseg:=tos;                                                  11455000
  end;                                                                  11460000
<<***************************************************************>>     11465000
                                                                        11470000
                                                                        11475000
                                                                        11480000
            << >>                                                       11485000
            <<abort process(false)/main(true) extra data segments>>     11490000
            << >>                                                       11495000
procedure abortdseg(main);                                              11500000
  value   main;                                                         11505000
  logical main;                                                         11510000
  option privileged,uncallable;                                         11515000
  begin                                                                 11520000
    logical val, dstx;                                         <<00428>>11525000
    integer refcnt;                                            <<00428>>11530000
                                                               <<00428>>11535000
    while (val := pxdseg (5, 0)) <> 0 do                       <<00428>>11540000
      begin                                                    <<00428>>11545000
        dstx := val.dsegf;                                     <<00428>>11550000
        if val.sharf then                                      <<00428>>11555000
          begin                                                <<00428>>11560000
            refcnt := xjdt (4, 0, dstx);                       <<00428>>11565000
            if refcnt = 0 then suddendeath (160);              <<00428>>11570000
          end                                                  <<00428>>11575000
        else                                                   <<00428>>11580000
          reldataseg (dstx);                                   <<00428>>11585000
      end;                                                     <<00428>>11590000
                                                               <<00428>>11595000
    if main then                                               <<00428>>11600000
      while (dstx := xjdt (3, 0, 0)) <> 0                      <<00428>>11605000
        do reldataseg (dstx);                                  <<00428>>11610000
  end << abortdseg >>;                                         <<00428>>11615000
<<***************************************************************>>     11620000
                                                                        11625000
                                                                        11630000
                                                               <<c+.09>>11635000
                                                               <<c+.09>>11640000
<<  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *   c+.09>>11645000
<< the following procedure is called by image/3000 to initial-   c+.09>>11650000
<<   ize a reserved cell in the pcbx with the plabel of a        c+.09>>11655000
<<   cleanup routine to be called upon process termination       c+.09>>11660000
<<   (from expire).  must be called with db pointing to stack.   c+.09>>11665000
<<  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *   c+.09>>11670000
                                                               <<c+.09>>11675000
procedure pcbximage(plabel);                                   <<c+.09>>11680000
  value plabel;                                                <<c+.09>>11685000
  logical plabel;                                              <<c+.09>>11690000
  option privileged, uncallable;                               <<c+.09>>11695000
  begin                                                        <<c+.09>>11700000
          << >>                                                <<c+.09>>11705000
          logical array qarray(*) = q+0;                       <<06636>>11710000
          logical pxfixedloc;                                  <<06636>>11715000
          << >>                                                <<c+.09>>11720000
          pxfixed;  <<get ready to use pxfixed include file>>  <<06636>>11725000
          pxfximageplbl := plabel;     << insert value. >>     <<06636>>11730000
  end; << pcbximage >>                                         <<c+.09>>11735000
                                                                        11740000
            << >>                                                       11745000
<<********************************************************>>            11750000
<<******  callable - capability 2 - data segments  *******>>            11755000
<<********************************************************>>            11760000
comment:                                                       <<04509>>11765000
            << create extra data segment. returns the logical index     11770000
               of data segment. also returns length if new access       11775000
               to job global data seg.                                  11780000
               note : privileged users do not need class 2 cap.         11785000
                       and the max number does not apply                11790000
                       also if length -ve then no maxdseg check         11795000
                                                                        11800000
               index := logical index of data seg                       11805000
               id    =0 - private data seg                              11810000
                    <>0 - job global data seg. if it exists             11815000
                           allow access else create                     11820000
               length = size of data seg (/<length<system max)          11825000
                                                                        11830000
               code: cc=0 ok.                                           11835000
                     cc>0 ok. no create-just access                     11840000
                     cc<0 no.  -illegal (0>=length>sysmax)              11845000
                                   index:=%2000                         11850000
                               -max number of data seg                  11855000
                                   index:=%2001                         11860000
                               -storage resource unavailable            11865000
                                   index:=%2002                <<04509>>11870000
                               -stack was frozen               <<04509>>11875000
                                   index:=%2003                <<04509>>11880000
                               -no room in jdt                 <<04509>>11885000
                                   index:=%2004  >>;           <<04509>>11890000
<<********************************************************>>            11895000
            << >>                                                       11900000
procedure getdseg(index,length,id);                                     11905000
  value   id;                                                           11910000
  logical index,id;                                                     11915000
  integer length;                                                       11920000
  option  privileged;                                                   11925000
  begin                                                                 11930000
          equate errn=130 , cap2=%2 , exitn=3;                          11935000
          equate errex=[10/errn,6/exitn];                               11940000
          double cap;                                                   11945000
          logical dstx,critic,ix,dx,mode;                               11950000
          logical ccerr:=cce;                                           11955000
          << >>                                                         11960000
          erroron;                                                      11965000
          cap:=if status.privf then 0d else double(cap2);               11970000
          chek(errex,3,%12d,cap);                                       11975000
          critic:=setcritical;                                          11980000
          if id <> 0 then                                      <<wh.22>>11985000
            begin     <<look for shared dst>>                  <<wh.22>>11990000
              <<search jdt for dst entry with id>>             <<wh.22>>11995000
              <<if entry found ref count is bumped>>           <<wh.22>>12000000
              dstx:=xjdt(0,id,0);                              <<wh.22>>12005000
              if dstx <> 0 then                                <<wh.22>>12010000
                begin    <<dst with id exists>>                <<wh.22>>12015000
                  <<search process pxfixed for dst>>           <<wh.22>>12020000
                  <<if found then process has accessed>>       <<wh.22>>12025000
                  <<dst before. if not then this is >>         <<wh.22>>12030000
                  <<process's first access        >>           <<wh.22>>12035000
                  index:=pxdseg(6,dstx);                       <<wh.22>>12040000
                  if index <> 0 then                           <<wh.22>>12045000
                    begin <<dst accessed before>>              <<wh.22>>12050000
                      ccerr:=ccg;                              <<wh.22>>12055000
                      length:=                                 <<wh.22>>12060000
                         (dsti'(dstx&lsl(2)).dsfld-1)&lsl(2);  <<wh.22>>12065000
                      ix:=xjdt(4,id,dstx);   << decrmt ref >>  <<01678>>12070000
                      go to fin;                               <<wh.22>>12075000
                    end else                                   <<wh.22>>12080000
                    begin <<process's first access to dst>>    <<wh.22>>12085000
                          <<above increment of rec count>>     <<wh.22>>12090000
                          <<must be nullified           >>     <<wh.22>>12095000
                      ix:=xjdt(4,id,dstx);   << decrmt ref >>  <<00428>>12100000
                    end;                                       <<wh.22>>12105000
                 end;                                          <<wh.22>>12110000
              end;                                             <<wh.22>>12115000
          if (ix:=pxdseg(0,0))=0 then                                   12120000
               begin tos:=1; goto error; end;                           12125000
          if ix = -1 then                                      <<00593>>12130000
            begin  << couldn't do stack expansion >>           <<00593>>12135000
              tos := 3;                                        <<00593>>12140000
              goto error;                                      <<00593>>12145000
            end;                                               <<00593>>12150000
          if id<>0 then                                                 12155000
               begin ix.sharf:=1;                                       12160000
                     if (dstx:=xjdt(0,id,0))<>0 then goto cont;         12165000
               end;                                                     12170000
          if status.privf and length<0 then                             12175000
               begin length:=-length; goto conty; end;                  12180000
          if length<0 or length>f(maxdseg')                    <<s7824>>12185000
                      or length>32764 then                     <<s7824>>12190000
               begin tos:=0; goto error; end;                           12195000
  conty:                                                                12200000
          length:=((length+3)&asr(2))&asl(2);                           12205000
          if (dstx:=if status.privf then getdataseg(length,0)<<00614>>  12210000
                           else getdatasegc(length,0))=0 then  <<00614>>12215000
               begin tos:=2;                                            12220000
                     goto error;                                        12225000
               end;                                                     12230000
          if id=0 then goto contx;                                      12235000
          <<make entry in jdt>>                                <<04509>>12240000
          if (dx:=xjdt(1,id,dstx))=0 then goto contx;                   12245000
          reldataseg(dstx);                                             12250000
          tos:=4;   <<no room in jdt>>                         <<04509>>12255000
          goto error;                                          <<04509>>12260000
  cont:   ccerr:=ccg;                                                   12265000
          length := (dsti'(dstx&lsl(2)).dsfld-1)&lsl(2);                12270000
  contx:  index:=pxdseg(dstx,ix);                                       12275000
                                                                        12280000
          goto fin;                                                     12285000
  error:  ccerr:=ccl;                                                   12290000
          index:=tos+%2000;                                             12295000
  fin:    status.ccfld:=ccerr;                                          12300000
          resetcritical(critic);                                        12305000
          errorexit(errex,0,0);                                         12310000
  end;                                                                  12315000
<<***************************************************************>>     12320000
                                                                        12325000
                                                                        12330000
                                                                        12335000
            << >>                                                       12340000
<<********************************************************>>            12345000
<<******  callable - capability 2 - data segments  *******>>            12350000
<<********************************************************>>            12355000
            <<release extra data segment. if no more references are     12360000
               being made to that data seg in job or it is a private    12365000
               data seg then it is destroyed. checks id vs index        12370000
                                                                        12375000
               index = logical index of data seg                        12380000
               id    =0 - private data seg                              12385000
                    <>0 - job global data seg                           12390000
                                                                        12395000
               code: cc=0 ok. destroyed                                 12400000
                     cc>0 ok. access released but data seg still        12405000
                                   in job                               12410000
                     cc<0 no.  -illegal index                           12415000
                               -illegal index vs id        >>           12420000
<<********************************************************>>            12425000
            << >>                                                       12430000
procedure freedseg(index,id);                                           12435000
  value   index,id;                                                     12440000
  logical index,id;                                                     12445000
  option  privileged;                                                   12450000
  begin                                                                 12455000
          equate errn=131 , cap2=%2 , exitn=2;                          12460000
          equate errex=[10/errn,6/exitn];                               12465000
          double cap;                                                   12470000
          logical dstx,critic,ix,ref;                                   12475000
          logical ccerr := ccg;                                         12480000
          << >>                                                         12485000
          erroron;                                                      12490000
          cap:=if status.privf then 0d else double(cap2);               12495000
          chek(errex,2,0d,cap);                                         12500000
          critic:=setcritical;                                          12505000
          if (ix:=pxdseg(3,index))=0 then                               12510000
               begin error: ccerr:=ccl; goto fin; end;                  12515000
          dstx:=pxdseg(2,ix);                                           12520000
          if ix.sharf then                                              12525000
               begin                                                    12530000
                     if id=0 then goto error;                           12535000
                     if (ref:=xjdt(2,id,dstx))=0 then goto error;       12540000
                     if ref>1 then goto cont;                           12545000
               end;                                                     12550000
          ccerr := cce;                                                 12555000
          reldataseg(dstx);                                             12560000
  cont:   pxdseg(1,ix);                                                 12565000
  fin:    status.ccfld:=ccerr;                                          12570000
          resetcritical(critic);                                        12575000
          errorexit(errex,0,0);                                         12580000
  end;                                                                  12585000
<<***************************************************************>>     12590000
                                                                        12595000
                                                                        12600000
                                                                        12605000
<<********************************************************>>            12610000
<<******  callable - capability 2 - data segments  *******>>            12615000
<<********************************************************>>            12620000
            <<increment/decrement extra data segment size.              12625000
               subject to the condition that the new size               12630000
               cannot exceed the original size specified to             12635000
               getdseg. thus memory storage requirements may be         12640000
               reduced dynamically to improve performance,the           12645000
               maximum disc storage having been allocated at            12650000
               time of creation. an error condition is returned         12655000
               if the data segment is frozen at the time of             12660000
               requesting the size change.                              12665000
                                                                        12670000
               index = logical index of data seg                        12675000
               inc   = increment(+ve)/decrement(-ve) to size            12680000
               size  := new size of data seg                            12685000
                                                                        12690000
               code: cc=0 ok.                                           12695000
                     cc>0 ok.  -illegal decrement due to new size<=0    12700000
                                   size:=current size                   12705000
                               -illegal increment due to new size>      12710000
                                   original getdseg size                12715000
                                   size:=orig getdseg size              12720000
                     cc<0 no.  -illegal index size:=0                   12725000
                               -frozen data seg size:=current  >>       12730000
<<********************************************************>>            12735000
procedure altdseg(index,inc,size);                                      12740000
  value   index,inc;                                                    12745000
  logical index;                                                        12750000
  integer inc,size;                                                     12755000
  option  privileged;                                                   12760000
  begin                                                                 12765000
          equate errn=134, cap2=%2 , exitn=3;                           12770000
          equate errex=[10/errn,6/exitn];                               12775000
          double cap;                                                   12780000
          logical critic,dstx;                                          12785000
          logical ccerr:=cce;                                           12790000
          integer vdssize;                                              12795000
          logical changeinc:=false;                            <<wh.22>>12800000
          << >>                                                         12805000
          erroron;                                                      12810000
          cap:=if status.privf then 0d else double(cap2);               12815000
          chek(errex,3,%40d,cap);                                       12820000
          critic:=setcritical;                                          12825000
          if (dstx:=pxdseg(4,index))=0 then                             12830000
               begin ccerr:=ccl;                                        12835000
                     size:=0;                                           12840000
                     goto fin;                                          12845000
               end;                                                     12850000
          if inc > 0 then                                      <<wh.22>>12855000
            begin  <<expansion-size cannot exceed vds>>        <<wh.22>>12860000
              size:=(dsti'(dstx&lsl(2)).dsfld)&lsl(2);         <<wh.22>>12865000
              vdssize:=dst(dstx&lsl(2)+1).npfld;                        12870000
              if ((size+inc+psm1)/integer(vmpagesize)) > vdssize then   12875000
                begin   <<too large-use maximum>>              <<wh.22>>12880000
                  inc:=vdssize*integer(vmpagesize)-size;      <<wh.22>> 12885000
                  changeinc:=true;                             <<wh.22>>12890000
                end;                                           <<wh.22>>12895000
            end;                                               <<wh.22>>12900000
          exchangedb(dstx);                                             12905000
          altdsegsize(dstx,inc);                                        12910000
          push(status);                                                 12915000
          ccerr:=tos.ccfld;                                             12920000
          <<change cce status if original inc was too big>>    <<wh.22>>12925000
          if changeinc and ccerr = cce then ccerr:=ccg;        <<wh.22>>12930000
          exchangedb(0);                                                12935000
          size := (dsti'(dstx&lsl(2)).dsfld-1)&lsl(2);                  12940000
  fin:    status.ccfld:=ccerr;                                          12945000
          resetcritical(critic);                                        12950000
          errorexit(errex,0,0);                                         12955000
  end;                                                                  12960000
<<***************************************************************>>     12965000
                                                                        12970000
                                                                        12975000
                                                                        12980000
            << >>                                                       12985000
            << stack to/from data segment move.                         12990000
               performs bounds check on segments and                    12995000
               returns condition code pattern directly                  13000000
               cc=0  ok                                                 13005000
               cc>0  data/stack seg bounds viol                         13010000
               cc<0  illegal index or number   >>                       13015000
            << >>                                                       13020000
logical procedure dmove(dstx,disp,number,loc,intostack,num);            13025000
  value   dstx,disp,number,loc,intostack,num;                           13030000
  logical dstx,intostack;                                               13035000
  integer disp,number,loc,num;                                          13040000
  option  privileged,uncallable;                                        13045000
  begin                                                                 13050000
          entry  dmove';                                                13055000
          double dd,dr;                                                 13060000
          integer size=dd,qvalue=dr,dlvalue=dr+1,deltaq=q+0;            13065000
          integer addr=dd+1,junk;                                       13070000
          logical dbsave,ccerr:=cce,f'=ccerr+1;                         13075000
          array base(*)=db+0;                                           13080000
          << >>                                                         13085000
          tos := 1;                                                     13090000
          goto startl;                                                  13095000
dmove'   :tos := 0;                                                     13100000
startl   :                                                              13105000
          if number=0 then goto fin;                                    13110000
          if (dstx=0) or (number<0) then                                13115000
               begin ccerr:=ccl; goto fin; end;                         13120000
          if disp<0 then goto error;                                    13125000
          if disp+number < 0 then go to error;                 <<00081>>13130000
          junk := 4;                                                    13135000
          size := (dsti'(dstx&lsl(2)).dsfld)&lsl(2);                    13140000
          if = then                                                     13145000
           begin               <<invalid entry>>                        13150000
            ccerr := ccl;                                               13155000
            goto fin;                                                   13160000
           end;                                                         13165000
          if > then                                                     13170000
           if dstl'(x:=x+1).segresidentflag then junk := 0;    <<01915>>13175000
          if (disp + number) > (size - junk) then                       13180000
           begin                                                        13185000
            if f' then                                                  13190000
             goto error;       <<old case>>                             13195000
            number := size - junk - disp;                               13200000
            ccerr := ccg;                                               13205000
           end;                                                         13210000
          push(q,dl); dr:=tos;                                          13215000
          if (loc<dlvalue) or ((loc+number-1)>(qvalue                   13220000
                                       -deltaq+num))                    13225000
               then begin error: ccerr:=ccg; goto fin; end;             13230000
          tos := loc;                <<db-relative displacement>>       13235000
          tos := dstx;               <<data seg entry number>>          13240000
          tos := disp;               <<data seg displacement>>          13245000
          if not intostack then                                         13250000
           asmb(cab);                                                   13255000
          tos := number;             <<move count>>                     13260000
          if intostack then                                             13265000
           mfdseg                   <<stack := dataseg>>                13270000
          else                                                          13275000
           mtdseg;                  <<dataseg := stack>>                13280000
  fin:    dmove:=ccerr;                                                 13285000
  end;                                                                  13290000
<<***************************************************************>>     13295000
                                                                        13300000
                                                                        13305000
                                                                        13310000
            << >>                                                       13315000
<<********************************************************>>            13320000
<<******  callable - capability 2 - data segments  *******>>            13325000
<<********************************************************>>            13330000
            << move from extra data segment to stack segment.           13335000
               bounds checking is performed.                            13340000
                                                                        13345000
               index = logical index of data seg (getdseg)              13350000
               disp  = displacement in data seg (>=0)                   13355000
               number = size of transfer (>=0)                          13360000
               location = stack array for destination                   13365000
                                                                        13370000
               code: cc=0 ok.                                           13375000
                     cc>0 no. bounds failure                            13380000
                     cc<0 no.  -illegal index                           13385000
                               -illegal number             >>           13390000
<<********************************************************>>            13395000
            << >>                                                       13400000
procedure dmovin(index,disp,number,location);                           13405000
  value   index,disp,number;                                            13410000
  logical index;                                                        13415000
  integer disp,number;                                                  13420000
  array   location;                                                     13425000
  option  privileged;                                                   13430000
  begin                                                                 13435000
          equate errn=132, cap2=%2 , exitn=4;                           13440000
          equate errex=[10/errn,6/exitn];                               13445000
          equate bound=-exitn-4;                                        13450000
          double cap;                                                   13455000
          logical dstx;                                                 13460000
          integer loc=q-4;                                              13465000
          logical ccerr:=cce;                                           13470000
          << >>                                                         13475000
          erroron;                                                      13480000
          cap:=if status.privf then 0d else double(cap2);               13485000
          chek(errex,4,%200d,cap);                                      13490000
          if (dstx:=pxdseg(4,index))=0 then                             13495000
               begin ccerr:=ccl; goto fin; end;                         13500000
          ccerr:=dmove(dstx,disp,number,loc,true,bound);                13505000
  fin:    status.ccfld:=ccerr;                                          13510000
          errorexit(errex,0,0);                                         13515000
  end;                                                                  13520000
<<***************************************************************>>     13525000
                                                                        13530000
                                                                        13535000
                                                                        13540000
            << >>                                                       13545000
<<********************************************************>>            13550000
<<******  callable - capability 2 - data segments  *******>>            13555000
<<********************************************************>>            13560000
            << move from stack segment to extra data segment.           13565000
               bounds checking is performed.                            13570000
                                                                        13575000
               index = logical index of data seg (getdseg)              13580000
               disp  = displacement in data seg (>=0)                   13585000
               number = size of transfer (>=0)                          13590000
               location = stack array of data source                    13595000
                                                                        13600000
               code: cc=0 ok.                                           13605000
                     cc>0 no. bounds failure                            13610000
                     cc<0 no.  -illegal index                           13615000
                               -illegal number             >>           13620000
<<********************************************************>>            13625000
            << >>                                                       13630000
procedure dmovout(index,disp,number,location);                          13635000
  value   index,disp,number;                                            13640000
  logical index;                                                        13645000
  integer disp,number;                                                  13650000
  array   location;                                                     13655000
  option  privileged;                                                   13660000
  begin                                                                 13665000
          equate errn=133, cap2=%2 , exitn=4;                           13670000
          equate errex=[10/errn,6/exitn];                               13675000
          equate bound=-exitn-4;                                        13680000
          double cap;                                                   13685000
          logical dstx;                                                 13690000
          integer loc=q-4;                                              13695000
          logical ccerr:=cce;                                           13700000
          << >>                                                         13705000
          erroron;                                                      13710000
          cap:=if status.privf then 0d else double(cap2);               13715000
          chek(errex,4,%200d,cap);                                      13720000
          if (dstx:=pxdseg(4,index))=0 then                             13725000
               begin ccerr:=ccl; goto fin; end;                         13730000
          ccerr:=dmove(dstx,disp,number,loc,false,bound);               13735000
  fin:    status.ccfld:=ccerr;                                          13740000
          errorexit(errex,0,0);                                         13745000
  end;                                                                  13750000
<<***************************************************************>>     13755000
                                                                        13760000
                                                                        13765000
                                                                        13770000
            << >>                                                       13775000
<<********************************************************>>            13780000
<<****  uncallable - capability 7 - priv mode      *******>>            13785000
<<********************************************************>>            13790000
            <<set db to the base of an extra data segment.              13795000
               returns the logical index of previous data segment.      13800000
               this intrinsic provides the interface between a          13805000
               privileged user running with extra data segments         13810000
               and exchangedb. a validity check is performed on         13815000
               the logical index.                                       13820000
                                                                        13825000
               index <> 0 logical index of data seg (getdseg)           13830000
                     =  0 stack segment                                 13835000
               switchdb := previous data seg log index                  13840000
                             (=0 stack seg)                             13845000
                                                                        13850000
               code: cc=0 ok.                                           13855000
                     cc>0 (null)                                        13860000
                     cc<0 no. illegal index                >>           13865000
<<********************************************************>>            13870000
            << >>                                                       13875000
logical procedure switchdb(index);                                      13880000
  value   index;                                                        13885000
  logical index;                                                        13890000
  option  privileged,uncallable;                                        13895000
  begin                                                                 13900000
          equate errn=139, exitn=1;                                     13905000
          equate errex=[10/errn,6/exitn];                               13910000
          logical dstx,dstz,crit;                                       13915000
          logical ccerr:=cce;                                           13920000
          << >>                                                         13925000
          crit := setcritical;                                          13930000
          erroron;                                                      13935000
          dstz:=exchangedb(0);                                          13940000
          if index=0 then goto cont;                                    13945000
          if (dstx:=pxdseg(4,index))=0 then                             13950000
               begin exchangedb(dstz);                                  13955000
                     dstz:=0;                                           13960000
                     ccerr:=ccl;                                        13965000
                     goto fin;                                          13970000
               end;                                                     13975000
  cont:   if dstz=0 then goto contx;                                    13980000
          tos:=pxdseg(6,dstz);                                          13985000
          assemble(test);                                               13990000
          if <> then dstz:=tos;                                         13995000
  contx:  if index<>0 then exchangedb(dstx);                            14000000
  fin:    switchdb:=dstz;                                               14005000
          status.ccfld:=ccerr;                                          14010000
          resetcritical(crit);                                          14015000
          errorexit(errex,0,0);                                         14020000
  end;                                                                  14025000
<<***************************************************************>>     14030000
$page ""                                                       <<01558>>14035000
$page "SOFTWARE INTERRUPT MANAGEMENT"                                   14040000
$page "SYSGLOB - FETCHES WORD FROM SYSGLOB AREA."              <<02830>>14045000
integer procedure sysglob(address);                            <<02830>>14050000
   value address;                                              <<02830>>14055000
   integer address;               << address of sysglob word >><<02830>>14060000
   option privileged;                                          <<02830>>14065000
                                                               <<02830>>14070000
<< this procedure fetches a word from the mpe system global >> <<02830>>14075000
<< area (sysglob) or sysglob extension and returns it as    >> <<02830>>14080000
<< value of the procedure.                                  >> <<02830>>14085000
<<                                                          >> <<02830>>14090000
<< input:                                                   >> <<02830>>14095000
<<    address - this is the address, relative to the start  >> <<02830>>14100000
<<       of the system global area, of the word to be re-   >> <<02830>>14105000
<<       turned.  addresses in the range 0 - %377 refer to  >> <<02830>>14110000
<<       sysglob,  while those in the range %400 - %577 re- >> <<02830>>14115000
<<       fer to the sysglob extension.                      >> <<02830>>14120000
<<                                                          >> <<02830>>14125000
<< procedure value:                                         >> <<02830>>14130000
<<    the contents of the addressed sysglob word are re-    >> <<02830>>14135000
<<    turned.                                               >> <<02830>>14140000
<<                                                          >> <<02830>>14145000
<< condition code:                                          >> <<02830>>14150000
<<    cce - the sysglob word was returned.                  >> <<02830>>14155000
<<                                                          >> <<02830>>14160000
<<    ccg - not used.                                       >> <<02830>>14165000
<<                                                          >> <<02830>>14170000
<<    ccl - <address> was not in the range 0 - %577.        >> <<02830>>14175000
                                                               <<02830>>14180000
begin << sysglob >>                                            <<02830>>14185000
                                                               <<02830>>14190000
<< the following declarations take advantage of an undocu-  >> <<02830>>14195000
<< mented feature of spl.  declarations of the form         >> <<02830>>14200000
<<                                                          >> <<02830>>14205000
<<    [<type>] pointer <pointer-name> = <integer>           >> <<02830>>14210000
<<                                                          >> <<02830>>14215000
<< specify a pointer located at absolute address %1000 +    >> <<02830>>14220000
<< <integer>.  the address contained in the pointer is also >> <<02830>>14225000
<< relative to absolute location %1000 (instead of db), so  >> <<02830>>14230000
<< that if @<pointer-name> is 1, <pointer-name> refers to   >> <<02830>>14235000
<< the contents of absolute location %1001.                 >> <<02830>>14240000
                                                               <<02830>>14245000
   define condcode = status.(6:2)#;  <<stack marker cc>>       <<02830>>14250000
   integer pointer sysglobp = 0;  << 1st word of sysglob >>    <<02830>>14255000
   integer pointer sysglobextp = %377; << sysglob extension >> <<02830>>14260000
                                                               <<02830>>14265000
                                                               <<02830>>14270000
      condcode := cce;                                         <<02830>>14275000
      if 0 <= address <= %377 then                             <<02830>>14280000
         sysglob := sysglobp(address)                          <<02830>>14285000
      else if %400 <= address <= %577 then                     <<02830>>14290000
         sysglob := sysglobextp(address - %400)                <<02830>>14295000
      else                                                     <<02830>>14300000
         condcode := ccl                                       <<02830>>14305000
                                                               <<02830>>14310000
   end; << sysglob >>                                          <<02830>>14315000
procedure loosesoftinterrupts;                                 <<03044>>14320000
   option privileged,uncallable;                               <<*7863>>14325000
                                                                        14330000
<<function                                                              14335000
  valid only for a terminating process.  cleans up any mess left        14340000
  by unprocessed soft interrupts.>>                                     14345000
                                                                        14350000
begin                                                                   14355000
asmb( adds 4 );  << space for msg >>                           <<06950>>14360000
do receivemsg(usermsgport,4,deletemsg) until >;                <<06950>>14365000
do receivemsg(systemsgport,4,deletemsg) until >;               <<06950>>14370000
end;  <<loosesoftinterrupts>>                                           14375000
procedure loosetrlx;                                           <<03044>>14380000
   option privileged,uncallable;                               <<*7863>>14385000
                                                                        14390000
<<function                                                              14395000
  valid only for a terminating process.  cleans up any mess left        14400000
  by pending timeouts.>>                                                14405000
                                                                        14410000
begin                                                                   14415000
logical array qarray(*) = q+0;                                 <<06636>>14420000
logical pxfixedloc;                                            <<06636>>14425000
                                                                        14430000
pxfixed;                                                                14435000
if pxfxtrlxtout <> 0 then                                      <<06636>>14440000
   begin                                                                14445000
   aborttimereq(pxfxtrlxtout);                                 <<06636>>14450000
   pxfxtrlxtout:=0;                                            <<06636>>14455000
   end;                                                                 14460000
end;  <<loosetrlx>>                                                     14465000
procedure resumesoftint;                                       <<03044>>14470000
                                                                        14475000
<<function                                                              14480000
  returns the process's soft interrupt state back to where it was       14485000
  when the control y trap occurred.                                     14490000
                                                                        14495000
  note: if the soft interrupt state is explicitly changed with          14500000
        fintstate after the control y occurs, then this procedure       14505000
        will not change the soft interrupt state.>>                     14510000
                                                                        14515000
begin                                                                   14520000
integer                                                                 14525000
   pcbpt;                                                      <<06636>>14530000
logical                                                                 14535000
   newstate;                                                            14540000
   logical array qarray(*) = q+0;                              <<06636>>14545000
   logical pxfixedloc;                                         <<06636>>14550000
                                                                        14555000
                                                                        14560000
pcbpt := curprc;                                               <<06651>>14565000
pxfixed;                                                                14570000
newstate:=pxfxsiflag;<<get the pre-controly soft int state>>   <<06636>>14575000
disable;                                                                14580000
spcballowsoft:=newstate;                                                14585000
if newstate and logical(portstatus(usermsgport)) then          <<06239>>14590000
   begin  <<interrupts enabled and have pending interrupt>>             14595000
   if spcbcritsir = 0 then                                              14600000
      begin  <<ok to start processing the interrupt>>                   14605000
      spcbsoftint:=1;                                                   14610000
      pdisable;                                                         14615000
      pseudoint;                                                        14620000
      end                                                               14625000
   else                                                                 14630000
      begin  <<must delay the interrupt>>                               14635000
      spcbdelaysoft:=1;                                                 14640000
      spcbpiovrflag:=1;                                                 14645000
      end;                                                              14650000
   end;                                                                 14655000
end;  <<resumesoftint>>                                                 14660000
$page "Cold Load Info Access - ATTACK'IO"                      <<06951>>14665000
logical procedure attack'io(func,buf);                         <<06951>>14670000
comment                                                        <<06951>>14675000
                                                               <<06951>>14680000
  this subroutine will do the attachio's to the cold load      <<06951>>14685000
information extension table.                                   <<06951>>14690000
                                                               <<06951>>14695000
;                                                              <<06951>>14700000
                                                               <<06951>>14705000
value func;                                                    <<06951>>14710000
integer func;                                                  <<06951>>14715000
logical array buf;                                             <<06951>>14720000
option internal,uncallable;                                    <<*7585>>14725000
                                                               <<06951>>14730000
                                                               <<06951>>14735000
begin                                                          <<06951>>14740000
                                                               <<06951>>14745000
define                                                         <<06951>>14750000
  status = ret1.(13:3)#,                                       <<06951>>14755000
  result = attack'io#;                                         <<06951>>14760000
                                                               <<06951>>14765000
equate                                                         <<06951>>14770000
  dstx = 0,                                                    <<06951>>14775000
  ok'status = 1,                                               <<06951>>14780000
  qmisc = 0,                                                   <<06951>>14785000
  cnt   =256,                                                  <<06951>>14790000
  sysdev=  1,                                                  <<06951>>14795000
  flags = 1;                                                   <<06951>>14800000
                                                               <<06951>>14805000
double ret;                                                    <<06951>>14810000
integer ret1 = ret;                                            <<06951>>14815000
integer ret2 = ret+1;                                          <<06951>>14820000
integer p1,p2;                                                 <<06951>>14825000
                                                               <<06951>>14830000
p1 := 0;                                                       <<06951>>14835000
p2 := 32;                                                      <<06951>>14840000
ret := attachio(sysdev,qmisc,dstx,@buf,func,cnt,p1,p2,flags);  <<07321>>14845000
if status <> ok'status then begin                              <<06951>>14850000
  ret := attachio(sysdev,qmisc,dstx,@buf,func,cnt,p1,p2,flags);<<07321>>14855000
  result := if status <> ok'status then true else false;       <<06951>>14860000
  end                                                          <<06951>>14865000
else result := false;                                          <<06951>>14870000
                                                               <<06951>>14875000
end; << attack'io >>                                           <<06951>>14880000
$page "Cold Load Info Access - PROCESS'COLD'LOAD'INFO"         <<06951>>14885000
integer procedure process'cold'load'info(func,word,            <<06951>>14890000
                                  parm1,parm2,parm3);          <<06951>>14895000
value func,word;                                               <<06951>>14900000
integer func,word;                                             <<06951>>14905000
logical parm1,parm2,parm3;                                     <<06951>>14910000
option privileged,uncallable,variable;                         <<06951>>14915000
                                                               <<06951>>14920000
comment                                                        <<06951>>14925000
                                                               <<06951>>14930000
allows access to the extention area of the cold load           <<06951>>14935000
information table.                                             <<06951>>14940000
                                                               <<06951>>14945000
inputs:                                                        <<06951>>14950000
  func - (value) function to be performed.                     <<06951>>14955000
  word - (value) word to use for the function.                 <<06951>>14960000
  parm1- function dependent parameter.                         <<06951>>14965000
  parm2- function dependent parameter.                         <<06951>>14970000
  parm3- function dependent parameter.                         <<06951>>14975000
                                                               <<06951>>14980000
ouput:                                                         <<06951>>14985000
  parm1- function dependent parameter.                         <<06951>>14990000
  parm2- function dependent parameter.                         <<06951>>14995000
  parm3- function dependent parameter.                         <<06951>>15000000
                                                               <<06951>>15005000
function return:  status -                                     <<06951>>15010000
  0 - request granted.                                         <<06951>>15015000
  1 - illegal function.                                        <<06951>>15020000
  2 - word out of range.                                       <<06951>>15025000
  3 - parm1 not specified correctly.                           <<06951>>15030000
  4 - parm2 not specified correctly.                           <<06951>>15035000
  5 - parm3 not specified correctly.                           <<06951>>15040000
  6 - i/o error                                                <<06951>>15045000
                                                               <<06951>>15050000
current functions:                                             <<06951>>15055000
  0 - read.  parm becomes the contents of the location         <<06951>>15060000
      word.                                                    <<06951>>15065000
  1 - write. the contents of parm1 are written to the          <<06951>>15070000
      location word.                                           <<06951>>15075000
                                                               <<06951>>15080000
                                                               <<06951>>15085000
current assigned entries:                                      <<06951>>15090000
                                                               <<06951>>15095000
                                                               <<06951>>15100000
0-20  reserved for future system use                           <<06951>>15105000
21    system log file number                                   <<06951>>15110000
22    network management log file number                       <<07321>>15115000
23    network management trace file number                     <<07321>>15120000
24    date last full dump was taken (fullbkup command)         <<07321>>15125000
25    date last full dump was taken (second word)              <<07321>>15130000
                                                               <<06951>>15135000
;                                                              <<06951>>15140000
begin                                                          <<06951>>15145000
                                                               <<06951>>15150000
define                                                         <<06951>>15155000
  status = process'cold'load'info#;                            <<06951>>15160000
                                                               <<06951>>15165000
equate                                                         <<06951>>15170000
  cold'load'sir =42,                                           <<06951>>15175000
  status'ok     = 0,                                           <<06951>>15180000
  illegal'func  = 1,                                           <<06951>>15185000
  word'out'range= 2,                                           <<06951>>15190000
  bad'parm1     = 3,                                           <<06951>>15195000
  bad'parm2     = 4,                                           <<06951>>15200000
  bad'parm3     = 5,                                           <<06951>>15205000
  io'error      = 6,                                           <<06951>>15210000
  largest'func  = 1;                                           <<06951>>15215000
                                                               <<06951>>15220000
integer sir'value;                                             <<06951>>15225000
logical dbdst;                                                 <<06951>>15230000
                                                               <<06951>>15235000
logical array sectors(0:255);                                  <<07321>>15240000
                                                               <<06951>>15245000
status := status'ok; << innocent unless proven guilty >>       <<06951>>15250000
dbdst := exchangedb(0);                                        <<06951>>15255000
if (0 < word) and (word <= 255) then                           <<06951>>15260000
  if (0 <= func) and (func <= largest'func) then               <<06951>>15265000
    begin                                                      <<06951>>15270000
    sir'value := getsir(cold'load'sir);                        <<06951>>15275000
    case func of begin                                         <<06951>>15280000
                                                               <<06951>>15285000
  << 0 >>                                                      <<06951>>15290000
                                                               <<06951>>15295000
    begin  << read >>                                          <<06951>>15300000
                                                               <<06951>>15305000
    if attack'io(0,sectors) then                               <<06951>>15310000
      status := io'error                                       <<06951>>15315000
    else parm1 := sectors(word);                               <<06951>>15320000
    end;                                                       <<06951>>15325000
                                                               <<06951>>15330000
  << 1 >>                                                      <<06951>>15335000
                                                               <<06951>>15340000
    begin  << write >>                                         <<06951>>15345000
                                                               <<06951>>15350000
    if attack'io(0,sectors) then                               <<06951>>15355000
      status := io'error                                       <<06951>>15360000
    else begin                                                 <<06951>>15365000
      sectors(word) := parm1;                                  <<06951>>15370000
      if attack'io(1,sectors) then                             <<06951>>15375000
        status := io'error;                                    <<06951>>15380000
      end;                                                     <<06951>>15385000
                                                               <<06951>>15390000
    end;                                                       <<06951>>15395000
                                                               <<06951>>15400000
    end;  << case >>                                           <<06951>>15405000
    relsir(cold'load'sir,sir'value);                           <<06951>>15410000
    end                                                        <<06951>>15415000
                                                               <<06951>>15420000
  else status := illegal'func                                  <<06951>>15425000
else status := word'out'range;                                 <<06951>>15430000
exchangedb(dbdst);                                             <<06951>>15435000
end;  << process'cold'load'info >>                             <<06951>>15440000
$page "Access procedures - PCB'INDEX"                          <<06951>>15445000
logical procedure pcb'index (pin,pcbx);                        <<06951>>15450000
value pin;                                                     <<06951>>15455000
integer pin,pcbx;                                              <<06951>>15460000
option privileged,uncallable;                                  <<06951>>15465000
                                                               <<06951>>15470000
comment                                                        <<06951>>15475000
                                                               <<06951>>15480000
returns the pcb index of the specified pin.                    <<06951>>15485000
                                                               <<06951>>15490000
inputs:  pin - (value) pin to find the pcb index for.  a       <<06951>>15495000
               pin of 0 indicates that the pcb index           <<06951>>15500000
               returned is for the current process.            <<06951>>15505000
                                                               <<06951>>15510000
output:  pcbx- the pcb index of the specified pin.             <<06951>>15515000
                                                               <<06951>>15520000
functional return:  status                                     <<06951>>15525000
    0 - request granted                                        <<06951>>15530000
    1 - pin is unassigned                                      <<06951>>15535000
    2 - pin is not a valid pin number                          <<06951>>15540000
                                                               <<06951>>15545000
;                                                              <<06951>>15550000
begin                                                          <<06951>>15555000
                                                               <<06951>>15560000
define                                                         <<06951>>15565000
  pcb'entries = (integer(lpcb(0))-1)#,                         <<06951>>15570000
  status = pcb'index#;                                         <<06951>>15575000
                                                               <<06951>>15580000
equate                                                         <<06951>>15585000
  status'ok      = 0,                                          <<06951>>15590000
  unassigned'pin = 1,                                          <<06951>>15595000
  not'valid'pin  = 2;                                          <<06951>>15600000
                                                               <<06951>>15605000
status := status'ok; << assume innocent until proven guilty >> <<06951>>15610000
if pin = 0 then  << wants current process >>                   <<06951>>15615000
  pcbx := curprc                                               <<06951>>15620000
else if (0 < pin) and (pin  <= pcb'entries) then               <<06951>>15625000
  begin                                                        <<06951>>15630000
  pcbx := pin * pcbsize;                                       <<06951>>15635000
  if not checkalive(pin) then                                  <<06951>>15640000
    status := unassigned'pin                                   <<06951>>15645000
  end                                                          <<06951>>15650000
else status := not'valid'pin;                                  <<06951>>15655000
                                                               <<06951>>15660000
end;  << pcb'index >>                                          <<06951>>15665000
                                                               <<06951>>15670000
integer procedure mpe;                                         <<06952>>15675000
                                                               <<06952>>15680000
<< return 1 if system is mpec >>                               <<06952>>15685000
<<        4 if mpe3 or mpe4   >>                               <<06952>>15690000
<<        5 if mpe5           >>                               <<06952>>15695000
<<        0 undefined         >>                               <<06952>>15700000
                                                               <<06952>>15705000
begin                                                          <<06952>>15710000
   equate mpe5'pcb'size = 21,                                  <<06952>>15715000
          mpe4'pcb'size = 16,                                  <<06952>>15720000
          mpec'pcb'size = %13;                                 <<06952>>15725000
                                                               <<06952>>15730000
   tos:=pcbi'(1);                                              <<06952>>15735000
   if s0 = mpe5'pcb'size then                                  <<06952>>15740000
      mpe:=5                                                   <<06952>>15745000
   else                                                        <<06952>>15750000
      if s0 = mpe4'pcb'size then                               <<06952>>15755000
         mpe:=4                                                <<06952>>15760000
      else                                                     <<06952>>15765000
         if s0 = mpec'pcb'size then                            <<06952>>15770000
            mpe:=1                                             <<06952>>15775000
         else                                                  <<06952>>15780000
            mpe:=0;                                            <<06952>>15785000
end;                                                           <<06952>>15790000
                                                               <<06952>>15795000
$control segment=main                                          <<06952>>15800000
end.                                                           <<06952>>15805000
