$CONTROL USLINIT,CODE,MAP,PRIVILEGED                                    00015000
<< logseg0 - module 90 >>                                               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
$title "LOGGING PROCESS"                                                00055000
$control adr                                                   <<01869>>00060000
<< store fully qualified filename correctly in the tables. >>  <<01869>>00085000
<<check for early release of logbuff dst.                   >> <<01869>>00090000
<< adds extra error checking and makes use of equated values.>><<01869>>00095000
<< correct recover from powerfail routine.                  >> <<01869>>00100000
<< changes equates to user new error msg -> ulogerr 28.    >>  <<01869>>00105000
<< fix non-recovery of logfile on warmstart >>                 <<01869>>00110000
<< enhancement - logging to labeled serial disc, linus  >>     <<01869>>00115000
<< post gap table after every write to serial disc. also>>     <<01869>>00120000
<< cleanup recovery routine to work for all logfiles    >>     <<01869>>00125000
<< make sure hdr labels posted to tape file right after fopen>><<01869>>00130000
<<  also perform abortio to tape upon a powerfail.           >><<01869>>00135000
<< preserve locking hierarchy - get logsir before resource. >> <<01869>>00140000
<< remove declarations of unused items. general clean up.    >><<01869>>00145000
<< new procedure to stop all log processes upon =shutdown.   >><<01869>>00150000
<< make db at stack when call fwritedir for restart.         >><<01869>>00155000
<< one last "fix" to powerfail recovery stuff.               >><<01869>>00160000
<< problem with log process calling flush and losing stops.  >><<01869>>00165000
<< make use of include file for table definitions, etc.      >><<01869>>00170000
<< remove all dependencies to the dst table.                 >><<01869>>00175000
<< print out file system errors along with u.l. errors.      >><<01869>>00180000
<< check for i/o channel timeout after powerfails in recpfail>><<01869>>00185000
<< solve problem of regular records in between cont records. >><<01869>>00190000
<< make sure dst field of logtab is null when initializing.  >><<01869>>00195000
<< enhancement -- changelog.                                 >><<01869>>00200000
                                                               <<01869>>00205000
begin                                                                   00210000
$control segment=logseg0,main=logseg0                                   00215000
$include inclpcb5                                              <<01869>>00220000
$include incllog                                               <<01869>>00225000
                                                                        00460000
<<file label equates>>                                                  00465000
                                                                        00470000
equate                                                                  00475000
eof               =       21,                                           00480000
fcode             =       26,                    <<file code>>          00485000
flimit            =       15,   << file limit >>               <<01869>>00490000
fblksize          =       38,   << blocksize >>                <<01869>>00495000
fextsize          =       41,   << size of extent >>           <<01869>>00500000
f'cksum           =       34,   << file label checksum       >><<01869>>00505000
creator'id        =       24,                                  <<01869>>00510000
lastext           =       40;             <<last extent size>>          00515000
                                                                        00520000
define                                                         <<01869>>00525000
offset'to'data  = 39).(0:8#;                                   <<01869>>00530000
                                                               <<01869>>00535000
                                                                        00540000
                                                                        00545000
equate                                                                  00550000
zero'length    =  0,                                                    00555000
pri            =   140,            <<priority of rec process>>          00560000
absys          =   %1000,                                               00565000
sysextptr      =   absys+%377,                                          00570000
locsize      =   1000,   <<q to z>>                            <<01869>>00575000
                                                                        00580000
                                                                        00585000
globsize       =   4620          <<blocksize>>+128<<rec size>>          00590000
+ 100                             <<misc>>+256<<primary db>> ,          00595000
initstack      =   globsize+locsize+512 ,          <<pcbx>>             00600000
maxstack    = initstack+4096;                                  <<01869>>00605000
                                                                        00610000
define                                                                  00615000
reclogplabel   =    absys+absolute(sysextptr)+%62#,                     00620000
reclogdeltap   =    absys+absolute(sysextptr)+%63#,                     00625000
a'             =    absolute#;                                          00630000
                                                                        00635000
                                                                        00640000
                                                                        00645000
define                                                                  00650000
                                                                        00655000
ulogplabel   =   absys+absolute(sysextptr)+%60#,                        00660000
ulogdeltap   =   absys+absolute(sysextptr)+%61#,                        00665000
ulogrstartplabel  =  absys+absolute(sysextptr)+%65#,                    00670000
ulogrstartdeltap  =  absys+absolute(sysextptr)+%64#;                    00675000
                                                                        00680000
                                                                        00685000
                                                                        00690000
integer pointer pdb  = db;                                     <<01869>>00695000
                                                               <<01869>>00700000
integer x = x;                                                          00705000
                                                                        00710000
<< any changes to the following db-relative declarations will>><<01869>>00715000
<< require changes to initlog & initreclog. those routines   >><<01869>>00720000
<< are responsible for initializing the logging process and  >><<01869>>00725000
<< the warmstart recovery process. that initialization       >><<01869>>00730000
<< involves setting up the addresses for these db variables. >><<01869>>00735000
                                                               <<01869>>00740000
                                                                        00745000
byte array zeros(0:3);                                         <<01869>>00750000
byte array forms(0:9);                                                  00755000
byte array fname(0:36);                                        <<01869>>00760000
byte array bfname(0:36);                                       <<01869>>00765000
byte array procname(0:8);                                               00770000
logical array buffarea(0:blksize-1);                           <<01869>>00775000
double array dbuffarea(*) = buffarea;                                   00780000
logical array discrec(0:recsizem1);                            <<01869>>00785000
double array ddiscrec(*) = discrec;                                     00790000
                                                                        00795000
                                                                        00800000
$page                                                          <<01869>>00805000
procedure delay(msec);                                         <<01869>>00810000
   value msec;                                                 <<01869>>00815000
   double msec;                                                <<01869>>00820000
   option external;                                            <<01869>>00825000
                                                               <<01869>>00830000
                                                               <<01869>>00835000
                                                               <<01869>>00840000
integer procedure getdataseg(memsize,vdsize);                           00845000
value memsize,vdsize;                                                   00850000
integer memsize,vdsize;                                                 00855000
option external;                                                        00860000
                                                                        00865000
                                                                        00870000
integer procedure flabio(d,s,f,a);                                      00875000
value d,s,f;                                                            00880000
integer d,f;                                                            00885000
double s;                                                               00890000
integer array a;                                                        00895000
option external;                                                        00900000
                                                                        00905000
                                                                        00910000
logical procedure exchangedb(dstx);                                     00915000
value dstx;                                                             00920000
logical dstx;                                                           00925000
option external;                                                        00930000
                                                                        00935000
                                                                        00940000
procedure awake(pcbpt,n,waitf);                                         00945000
value pcbpt,n,waitf;                                                    00950000
integer pcbpt,n,waitf;                                                  00955000
option privileged uncallable,external;                                  00960000
                                                                        00965000
procedure wait(waitc,jpcountx);                                         00970000
value waitc,jpcountx;                                                   00975000
integer waitc,jpcountx;                                                 00980000
option privileged,uncallable,external;                                  00985000
                                                                        00990000
                                                                        00995000
logical procedure getsir(sirn);                                         01000000
value sirn;                                                             01005000
integer sirn;                                                           01010000
option privileged,uncallable,external;                                  01015000
                                                                        01020000
procedure relsir(sirn,a);                                               01025000
value sirn,a;                                                           01030000
integer sirn;                                                           01035000
logical a;                                                              01040000
option privileged,uncallable,external;                                  01045000
                                                                        01050000
double procedure attachio(ldev,qmisc,dstx,addr,func,cnt,p1,p2,flags);   01055000
value ldev,qmisc,dstx,addr,func,cnt,p1,p2,flags;                        01060000
integer ldev,qmisc,dstx,addr,func,cnt,p1,p2,flags;                      01065000
option external;                                                        01070000
procedure logclose(a,b,c);                                     <<01869>>01075000
value a,b,c;                                                   <<01869>>01080000
integer a,b,c;                                                 <<01869>>01085000
option external;                                               <<01869>>01090000
                                                               <<01869>>01095000
                                                                        01100000
intrinsic debug;                                               <<01869>>01105000
intrinsic ffileinfo;                                           <<01869>>01110000
intrinsic fcontrol,fspace;                                     <<01869>>01115000
intrinsic fopen,fclose,freaddir,fwritedir,fgetinfo,fwrite;     <<01869>>01120000
intrinsic fpoint,fcheck,ascii,dascii,clock,calendar,fread;     <<01869>>01125000
intrinsic fsetmode;                                            <<01869>>01130000
                                                                        01135000
                                                                        01140000
                                                                        01145000
                                                                        01150000
logical procedure findlog(logname,index);                               01155000
integer index;                                                          01160000
byte array logname;                                                     01165000
option forward;                                                         01170000
                                                                        01175000
logical procedure recpfail(buffileno,recnum,tapeldev,first);   <<01869>>01180000
value buffileno,recnum,tapeldev,first;                         <<01869>>01185000
integer buffileno,tapeldev;                                    <<01869>>01190000
logical first;                                                 <<01869>>01195000
double recnum;                                                          01200000
option forward;                                                         01205000
                                                               <<01869>>01210000
                                                               <<01869>>01215000
logical procedure gentry(index,type);                                   01220000
value type;                                                             01225000
integer index,type;                                                     01230000
option forward;                                                         01235000
                                                                        01240000
                                                                        01245000
integer procedure genmsg(setno,msgno,mask,parm1,parm2,parm3,            01250000
parm4,parm5,dest,reply,offset,dst',control);                            01255000
value setno,msgno,mask,parm1,parm2,parm3,parm4,parm5,dest,              01260000
reply,offset,dst',control;                                              01265000
integer setno,msgno,dest,dst';                                          01270000
logical mask,parm1,parm2,parm3,parm4,parm5,reply,offset,                01275000
control;                                                                01280000
option variable,external;                                               01285000
                                                                        01290000
                                                                        01295000
procedure reldataseg(ix);                                               01300000
value ix;                                                               01305000
integer ix;                                                             01310000
option external;                                                        01315000
                                                                        01320000
                                                                        01325000
procedure relentry(index,type);                                <<01869>>01330000
value index,type;                                                       01335000
integer index,type;                                                     01340000
option forward;                                                         01345000
procedure fentry'switch(logid',pass',fname',uname',            <<01869>>01350000
uacct',type');                                                 <<01869>>01355000
byte array logid',pass',fname',uname',uacct';                  <<01869>>01360000
logical type';                                                 <<01869>>01365000
option external,privileged,variable;                           <<01869>>01370000
procedure fentry(logid',pass',fname',uname',                            01375000
uacct',type');                                                          01380000
byte array logid',pass',fname',uname',uacct';                           01385000
logical type';                                                          01390000
option external,privileged,variable;                                    01395000
                                                                        01400000
procedure deposit'filename(string,fn,lw',gn,an);               <<01869>>01405000
   byte array string,fn,lw',gn,an;                             <<01869>>01410000
   option external;                                            <<01869>>01415000
                                                               <<01869>>01420000
                                                               <<01869>>01425000
procedure extract'filename(string,fn,lw',gn,an);               <<01869>>01430000
   byte array string,fn,lw',gn,an;                             <<01869>>01435000
   option external;                                            <<01869>>01440000
                                                               <<01869>>01445000
                                                                        01450000
procedure release(res,altres,wakeup);                                   01455000
value res,altres,wakeup;                                                01460000
logical wakeup;                                                         01465000
logical pointer res,altres;                                             01470000
option external;                                                        01475000
                                                                        01480000
integer procedure obtain(res,altres);                                   01485000
value res,altres;                                                       01490000
logical pointer res,altres;                                             01495000
option external;                                                        01500000
                                                                        01505000
integer procedure lun(vtabindx,mvtabx);                                 01510000
value vtabindx,mvtabx;                                                  01515000
integer vtabindx,mvtabx;                                                01520000
option external;                                                        01525000
                                                                        01530000
                                                                        01535000
                                                                        01540000
procedure procreate (pinn, plabel, deltap, stackdst, globsize, <<01869>>01545000
                     dlsize, locsize, pri, string, stringlnth, <<01869>>01550000
                     parm, flags, maxstack, stdin, stdlist);   <<01869>>01555000
  value plabel, deltap, stackdst, globsize, dlsize, locsize,   <<01869>>01560000
        pri, string, stringlnth, parm, flags, maxstack;        <<01869>>01565000
  integer plabel, deltap, stackdst, globsize, dlsize, locsize, <<01869>>01570000
          pri, string, stringlnth, parm, pinn, maxstack;       <<01869>>01575000
  logical flags;                                               <<01869>>01580000
  logical array stdin, stdlist;                                <<01869>>01585000
  option external;                                             <<01869>>01590000
                                                                        01595000
logical procedure alter'lid'entry(lid,pass,fname,type);        <<01869>>01600000
value type;                                                    <<01869>>01605000
byte array lid,pass,fname;                                     <<01869>>01610000
integer type;                                                  <<01869>>01615000
option variable,uncallable,external;                           <<01869>>01620000
                                                                        01625000
logical procedure getstack(n,mp);                                       01630000
value n,mp;                                                             01635000
logical n,mp;                                                           01640000
option external;                                                        01645000
                                                                        01650000
                                                                        01655000
procedure writedseg(en);                                                01660000
value en;                                                               01665000
integer en;                                                             01670000
option external;                                                        01675000
                                                                        01680000
integer procedure adopt(a,b);                                  <<01869>>01685000
value a,b; integer a,b;                                        <<01869>>01690000
option external, privileged;                                   <<01869>>01695000
                                                               <<01869>>01700000
integer procedure fgetpvinfo(filenum);                         <<01869>>01705000
value filenum;                                                 <<01869>>01710000
integer filenum;                                               <<01869>>01715000
option external;                                               <<01869>>01720000
                                                               <<01869>>01725000
                                                                        01730000
procedure flush(index,flag);                                   <<01869>>01735000
value index,flag;                                              <<01869>>01740000
integer index;                                                 <<01869>>01745000
logical flag;                                                  <<01869>>01750000
option external;                                               <<01869>>01755000
                                                                        01760000
procedure move'from'dseg(target,segment,offset,count);         <<01869>>01765000
   value target,segment,offset,count;                          <<01869>>01770000
   integer target,segment,offset,count;                        <<01869>>01775000
   option forward,internal;                                    <<01869>>01780000
                                                               <<01869>>01785000
                                                               <<01869>>01790000
procedure move'to'dseg(segment,offset,source,count);           <<01869>>01795000
   value segment,offset,source,count;                          <<01869>>01800000
   integer segment,offset,source,count;                        <<01869>>01805000
   option forward,internal;                                    <<01869>>01810000
                                                               <<01869>>01815000
                                                               <<01869>>01820000
                                                               <<01869>>01825000
integer procedure iostat(stat);                                <<01869>>01830000
   value stat;                                                 <<01869>>01835000
   integer stat;                                               <<01869>>01840000
   option external;                                            <<01869>>01845000
                                                               <<01869>>01850000
                                                               <<01869>>01855000
procedure del'lockword(filename);                              <<01869>>01860000
   byte array filename;                                        <<01869>>01865000
   option forward;                                             <<01869>>01870000
                                                               <<01869>>01875000
                                                               <<01869>>01880000
$page  "Logging Process Declarations"                          <<01869>>01935000
logical procedure ulogproc;                                    <<01869>>01940000
                                                               <<01869>>01945000
option privileged,uncallable;                                           01950000
begin                                                                   01955000
                                                                        01960000
comment                                                        <<01869>>01965000
                                                               <<01869>>01970000
user logging process. has responsibility for creating          <<01869>>01975000
and initializing the logging buffer table. it will open the    <<01869>>01980000
user logging files - the disc logging file (disc logging) or   <<01869>>01985000
the tape logging file and the disc buffer file (tape logging). <<01869>>01990000
                                                               <<01869>>01995000
if a restart was requested (via the log command), then will    <<01869>>02000000
re-read the logging file to find where it left off, output a   <<01869>>02005000
log restart record to the buffer area of the logging buffer and<<01869>>02010000
continue as if a start was requested. if a start was requested,<<01869>>02015000
then will output a log header (start) record to the buffer area<<01869>>02020000
                                                               <<01869>>02025000
after this initialization, will wait (at label wait1) for a    <<01869>>02030000
request from a user (via the intrinsics). the type of action   <<01869>>02035000
desired by the user will be communicated here via the global   <<01869>>02040000
area of the logging buffer. this process will then perform the <<01869>>02045000
function, clear the request word, and return any error conditio<<01869>>02050000
to the user process, and then wait for another request.        <<01869>>02055000
                                                               <<01869>>02060000
when the request is to stop, will set the internal message word<<01869>>02065000
of the global area, and wait for the number of active users to <<01869>>02070000
become zero. at this point the buffer area will be flushed to  <<01869>>02075000
the logging file, the files closed, and the logging buffer tabl<<01869>>02080000
will be released.                                              <<01869>>02085000
note:                                                          <<01869>>02090000
  cartridge tape and serial disc logfiles are treated the same <<01869>>02095000
  as tape logfiles.                                            <<01869>>02100000
                                                               <<01869>>02105000
;                                                              <<01869>>02110000
                                                                        02115000
                                                                        02120000
entry restart;                                                          02125000
                                                                        02130000
                                                               <<01869>>02135000
equate                                                         <<01869>>02140000
   print'nothing    = 0,                                       <<01869>>02145000
   print'procname   = 1,                                       <<01869>>02150000
   print'fname      = 2,                                       <<01869>>02155000
   print'bfname     = 3,                                       <<01869>>02160000
   print'prev       = 4;                                       <<01869>>02165000
                                                               <<01869>>02170000
double                                                                  02175000
   addr,         << disc address of current extent of the    >>         02180000
                 << buffer file or disc log file.            >>         02185000
   att'stat,     << return from attachio.                    >>         02190000
   blocknum,     << last blk # of current extent (disc log). >>         02195000
   currrec,      << current record number + 1 (next rec #)   >>         02200000
   dtemp,        <<                                          >>         02205000
   flabaddr,     << address of file label                    >><<01869>>02210000
   lastrec,      << last good record found by checkrecord.   >>         02215000
   limit,        << file limit of disc log file.             >>         02220000
   outbufrec,    << next blk # ot move from disc buffer file.>><<01869>>02225000
   q'old'limit;  << file limit of previous disc log file.    >><<01869>>02230000
                                                                        02235000
integer                                                                 02240000
   a,            << used for getsir/relsir of logsir.        >>         02245000
   addr1 = addr,                                                        02250000
   addr2 = addr + 1,                                                    02255000
   att'stat0 = att'stat,                                                02260000
   bufdst,       << dst # of the logbuff.                    >>         02265000
   buffileno,    << file number of the disc buffer file.     >>         02270000
   count,        << used to determine how many reads are need>>         02275000
                 <<   to empty the disc buffer file.         >>         02280000
   discldev,     << ldev for current extent.                 >><<01869>>02285000
   errcode,      << file system error number (from fcheck).  >>         02290000
   extnum,       << current extent number.                   >>         02295000
   file'name'len,<< length of file name.                     >><<01869>>02300000
   fileno,       << file number of the log file.             >>         02305000
   flabaddr1 = flabaddr,                                       <<01869>>02310000
   flagaddr2 = flabaddr + 1,                                   <<01869>>02315000
   flabldev,     << ldev for file label of disc (buf) file   >><<01869>>02320000
   i,            << # good records in the block - checkblock >>         02325000
                 <<   loop counter when intializing logbuff. >>         02330000
   index,        << word offset to user entry in logbuff.    >>         02335000
   j,            << # fill records needed by format'trailer. >>         02340000
   last'rec'code,<< code of last record - continue'logging.  >>         02345000
   len,          << minimum length of dst for the logbuff.   >>         02350000
   maxusers,     << max # users per log process.             >>         02355000
   msgno,        << message # for genmsg.                    >>         02360000
   numext,       << max # extents allowed for disc log file. >>         02365000
   q'newtype,    << type for the next log file in the set.   >><<01869>>02370000
   q'old'numext, << number of extents in previous log file.  >><<01869>>02375000
   q'oldtype,    << type for the previous log file in the set>><<01869>>02380000
   q'vsetno,     << current file sequence.                   >><<01869>>02385000
   savefileno,   << file number of previous log file in set. >><<01869>>02390000
   tapedev,      << if tape logging - ldev # of tape drive.  >>         02395000
   tabindex,     << word offset to entry in the logtab.      >>         02400000
   tabindex' = q-4,<< same as above. passed here by pcreate. >>         02405000
   temp,         << # for the buffer file name.              >>         02410000
   tempcnt,      << used when need more than one write to    >><<01869>>02415000
                 <<  empty the disc buffer file.             >>         02420000
   ulerrcode;    << user logging error number                >><<01869>>02425000
                                                                        02430000
logical                                                                 02435000
   allow'changelog,<< true if allow :changelog               >><<01869>>02440000
   abnormal'exit,<< true of error and disc logging.          >>         02445000
   dummy,        << dummy parm for fcontrol calls.           >>         02450000
   eoforerr,     << loop terminator for continue'logging.    >>         02455000
   extsize,      << size of current disc log file extent.    >>         02460000
   first'tape'block,   << true if writing 1st tape block     >><<01869>>02465000
   free'last'extent,  << true if last record of last extent  >>         02470000
                  <<   has been released when stop disc log. >>         02475000
   formatted'trailer,  << true if trailer record done.       >>         02480000
   got'logbuff,  << true if created logbuff                  >><<01869>>02485000
   lid'typ,      << type field from lidtab                   >><<01869>>02490000
   notified,     << true is message printed to console.      >>         02495000
   resflag,      << true if locked the logbuff.              >>         02500000
   restart',     << true if restart entry point was used.    >>         02505000
   switch'flag,  << true if processing a changelog.          >>         02510000
   tape',        << true if tape log file.                   >>         02515000
   user'requested'change,  << true if requested changelog.   >><<01869>>02520000
   valid;        << true if good block from checkblock.      >>         02525000
                                                                        02530000
logical pointer                                                         02535000
   buf,          << ptr to buffer area of logbuff.           >>         02540000
   recptr;       << ptr within buffer area to put next rec.  >>         02545000
                                                                        02550000
double pointer                                                          02555000
   dbuf,         << same as buf.                             >>         02560000
   drecptr;      << same as recptr.                          >>         02565000
                                                                        02570000
byte pointer                                                            02575000
   bbuf,         << same as buf.                             >>         02580000
   brecptr;      << same as recptr.                          >>         02585000
                                                                        02590000
byte array dev(0:7);                                           <<01869>>02595000
                                                               <<01869>>02600000
<< local copy of logtab entry. >>                              <<01869>>02605000
                                                               <<01869>>02610000
logical array entry'(0:tentrysize-1) = q;                      <<01869>>02615000
byte array bentry'(*) = entry';                                         02620000
double array dentry'(*) = entry';                                       02625000
byte array temp'file'name'(0:8);                               <<01869>>02630000
byte array old'file'name(0:36);                                <<01869>>02635000
logical array flab(0:127)=q;                                            02640000
byte array bflab(*) = flab;                                    <<01869>>02645000
double array dflab(*) = flab;                                           02650000
$page "Logging Process -- CheckMsg"                            <<01869>>02655000
subroutine checkmsg;                                           <<01869>>02660000
begin                                                          <<01869>>02665000
                                                               <<01869>>02670000
<< this subroutine is used to check for special conditions >>  <<01869>>02675000
<< after calling flush.                                    >>  <<01869>>02680000
<< db is at logbuff. if msg word is stop and got an error  >>  <<01869>>02685000
<< then will go to close the log file and terminate.       >>           02690000
                                                                        02695000
                                                               <<01869>>02700000
                                                               <<01869>>02705000
if logbuff(usermsg) <> continue  or                            <<01869>>02710000
   logbuff(logmsg) <> continue  then                           <<01869>>02715000
   begin                                                       <<01869>>02720000
                                                               <<01869>>02725000
   if logbuff(state) = initializing then go init'fail;         <<01869>>02730000
                                                               <<01869>>02735000
   if switch'flag then                                         <<01869>>02740000
      begin                                                    <<01869>>02745000
      if logbuff(logmsg) = writeerr then                       <<01869>>02750000
         begin                                                 <<01869>>02755000
         ulerrcode := fwriteerror;                             <<01869>>02760000
         go changelog'error'recovery;                          <<01869>>02765000
         end;                                                  <<01869>>02770000
      end;                                                     <<01869>>02775000
                                                               <<01869>>02780000
   if logbuff(usermsg) = discspace then go getit;              <<01869>>02785000
                                                               <<01869>>02790000
   if logbuff(msg) = stop and logbuff(numuser) = 0  then       <<01869>>02795000
      begin                                                    <<01869>>02800000
      << we have an error during the stop, just quit >>        <<01869>>02805000
                                                               <<01869>>02810000
      if logbuff(logmsg) = writeerr then                       <<01869>>02815000
         begin                                                 <<01869>>02820000
         if logbuff(logtype) = disc  then                      <<01869>>02825000
            begin                                              <<01869>>02830000
            logbuff(msg) := stop;                              <<01869>>02835000
            abnormal'exit := true;                             <<01869>>02840000
            end                                                <<01869>>02845000
         else logbuff(msg) := suspend;                         <<01869>>02850000
                                                               <<01869>>02855000
         go wait1;                                             <<01869>>02860000
         end;        << write error >>                         <<01869>>02865000
                                                               <<01869>>02870000
      if logbuff(logmsg) = eofonlogfile then                   <<01869>>02875000
         begin                                                 <<01869>>02880000
         if dlogbuff(fspace') = 0d and formatted'trailer then  <<01869>>02885000
            begin                                              <<01869>>02890000
            logbuff(logmsg) := continue;                       <<01869>>02895000
            logbuff(usermsg) := continue;                      <<01869>>02900000
            end                                                <<01869>>02905000
         else                                                  <<01869>>02910000
            begin                                              <<01869>>02915000
            if logbuff(logtype) = disc then                    <<01869>>02920000
               begin                                           <<01869>>02925000
               abnormal'exit := true;                          <<01869>>02930000
               go close'disc'file;                             <<01869>>02935000
               end                                             <<01869>>02940000
            else go close'serial'file;                         <<01869>>02945000
            end;                                               <<01869>>02950000
         end;       << eof on the log file >>                  <<01869>>02955000
      end;         << error while stopping >>                  <<01869>>02960000
   end;                                                        <<01869>>02965000
                                                               <<01869>>02970000
end;       << subroutine checkmsg >>                           <<01869>>02975000
$page "Logging Process -- Format'Trailer"                      <<01869>>02980000
subroutine format'trailer;                                     <<01869>>02985000
begin                                                                   02990000
                                                                        02995000
<< outputs a trailer record padded by null records to fill out <<01869>>03000000
<< the block. db at logbuff.                                >> <<01869>>03005000
<<                                                          >>          03010000
<< variables used:                                          >>          03015000
<<   buf    - ptr to where record will reside in logbuff.   >>          03020000
<<   dtemp  -                                               >>          03025000
<<   j      - # available records in the logbuff.           >>          03030000
                                                                        03035000
                                                               <<01869>>03040000
                                                               <<01869>>03045000
dtemp := (dlogbuff(trecs)-dlogbuff(recs'in'prev))/             <<01869>>03050000
         double(blkfactor);                                    <<01869>>03055000
dtemp := dtemp * double(blkfactor);                            <<01869>>03060000
j := integer((dlogbuff(trecs)-dlogbuff(recs'in'prev))-dtemp);  <<01869>>03065000
j := blkfactor - j;                                            <<01869>>03070000
if ilogbuff(bspace) < j  then                                  <<01869>>03075000
   begin                                                       <<01869>>03080000
                                                               <<01869>>03085000
   << not enough room in the buffer for the trailer   >>       <<01869>>03090000
   << record. we need to flush it and then add the    >>       <<01869>>03095000
   << trailer record.                                       >> <<01869>>03100000
                                                               <<01869>>03105000
   flush(null,false);<< tell it we are the log process   >>    <<01869>>03110000
   checkmsg;                                                   <<01869>>03115000
   end;                                                        <<01869>>03120000
                                                               <<01869>>03125000
@buf := bufbase + logbuff(bufused) * recsize;                  <<01869>>03130000
@dbuf := @buf;                                                 <<01869>>03135000
@bbuf := 2 * @buf;                                             <<01869>>03140000
                                                                        03145000
<< clear out available space in buffer area >>                          03150000
                                                                        03155000
buf := "  ";                                                   <<01869>>03160000
move buf(1) := buf, (logbuff(bspace)*recsize-1);               <<01869>>03165000
                                                                        03170000
buf(code) := trailer;                                          <<01869>>03175000
move bbuf(lid') := blogbuff(logid), (8);                       <<01869>>03180000
logbuff(bspace) := logbuff(bspace) - logical(j);               <<01869>>03185000
logbuff(bufused) := logbuff(bufused) + logical(j);             <<01869>>03190000
                                                                        03195000
do                                                             <<01869>>03200000
   begin                                                       <<01869>>03205000
   dbuf(rnum) := dlogbuff(trecs) := dlogbuff(trecs) + 1d;      <<01869>>03210000
   buf(date) := calendar;                                      <<01869>>03215000
   dbuf(time) := clock;                                        <<01869>>03220000
   x := recsizem1;                                             <<01869>>03225000
   tos := -1;                                                  <<01869>>03230000
   do                                                          <<01869>>03235000
      begin                                                    <<01869>>03240000
      if x <> cksum then                                       <<01869>>03245000
      tos := tos xor buf(x);                                   <<01869>>03250000
      end                                                               03255000
   until (x := x-1) < 0;                                                03260000
   buf(cksum) := tos;                                          <<01869>>03265000
   @buf := @dbuf := @buf + recsize;                            <<01869>>03270000
   end                                                                  03275000
until (j := j-1) <= 0;                                                  03280000
                                                               <<01869>>03285000
end;   << subroutine format'trailer >>                         <<01869>>03290000
$page "Logging Process -- FormatRestart"                       <<01869>>03295000
subroutine formatrestart;                                               03300000
begin                                                                   03305000
                                                                        03310000
                                                                        03315000
<< formats a restart record, places it in the buffer area of>>          03320000
<< the buffer area, and clears the remainder of the buffer  >>          03325000
<< area. db at logbuff.                                     >>          03330000
<<                                                          >>          03335000
<<   entry:                                                 >>          03340000
<<     currrec - current record number + 1.                 >>          03345000
<<     recptr  - ptr to where this record will be placed in >>          03350000
<<                  the logbuff.                            >>          03355000
<<     i       - # records already in the logbuff buffer.   >>          03360000
                                                                        03365000
                                                                        03370000
                                                               <<01869>>03375000
   @brecptr := @recptr * 2;                                    <<01869>>03380000
                                                                        03385000
   << clear out remainder of the logbuff buffer area. >>                03390000
                                                                        03395000
   recptr := "  ";                                             <<01869>>03400000
   move recptr(1) := recptr, ((blkfactor-i)*recsize-1);        <<01869>>03405000
                                                                        03410000
   drecptr(rnum):=currrec;                                              03415000
   recptr(code):=rstart;                                                03420000
   move brecptr(lid') := blogbuff(logid), (8);                 <<01869>>03425000
   recptr(date):=calendar;                                              03430000
   drecptr(time):=clock;                                                03435000
   x:=recsizem1;                                               <<01869>>03440000
   tos:=-1;                                                             03445000
   do                                                                   03450000
      begin                                                             03455000
      if x <> cksum then                                                03460000
      tos:=tos xor recptr(x);                                           03465000
      end                                                               03470000
   until (x:=x-1) < 0;                                                  03475000
   recptr(cksum):=tos;                                                  03480000
                                                               <<01869>>03485000
   flush(null,false);                                          <<01869>>03490000
   checkmsg;                                                   <<01869>>03495000
end;   << subroutine formatrestart >>                                   03500000
$page  "Logging Process -- Format'First'File"                  <<01869>>03505000
subroutine format'first'file;                                  <<01869>>03510000
   begin                                                       <<01869>>03515000
   << formats the first log record to the new log file upon  >><<01869>>03520000
   << changelog. this record will provide linkage to the     >><<01869>>03525000
   << previous log file in the set.                          >><<01869>>03530000
                                                               <<01869>>03535000
   @buf := bufbase + logbuff(bufused)*recsize;                 <<01869>>03540000
   @dbuf:=@buf;                                                <<01869>>03545000
   @bbuf:=2*@buf;                                              <<01869>>03550000
   buf := "  ";                                                <<01869>>03555000
   move buf(1) := buf, (logbuff(bspace)*recsize-1);            <<01869>>03560000
   dbuf(rnum):=dlogbuff(trecs):=dlogbuff(trecs)+1d;            <<01869>>03565000
   buf(code):=first'code;                                      <<01869>>03570000
   move bbuf(lid') := blogbuff(logid), (8);                    <<01869>>03575000
   buf(date):=calendar;                                        <<01869>>03580000
   dbuf(time):=clock;                                          <<01869>>03585000
   buf(seq):=logbuff(vsetno);                                  <<01869>>03590000
   move bbuf(f'file'name):=blogbuff(first'file),(35);          <<01869>>03595000
   move bbuf(p'file'name):=blogbuff(previous'file),(35);       <<01869>>03600000
   move bbuf(c'file'name):=blogbuff(current'file),(35);        <<01869>>03605000
   buf(f'file'type):=logbuff(f'type);                          <<01869>>03610000
   buf(p'file'type):=logbuff(p'type);                          <<01869>>03615000
   buf(c'file'type):=logbuff(c'type);                          <<01869>>03620000
   dbuf(c'time):=dlogbuff(first'c'time);                       <<01869>>03625000
   buf(c'date):=logbuff(first'c'date);                         <<01869>>03630000
   logbuff(bspace):=logbuff(bspace)-1;                         <<01869>>03635000
   logbuff(bufused):=logbuff(bufused)+1;                       <<01869>>03640000
   x:=recsizem1;                                               <<01869>>03645000
   tos:=-1;                                                    <<01869>>03650000
   do                                                          <<01869>>03655000
      begin                                                    <<01869>>03660000
      if x <> cksum then                                       <<01869>>03665000
      tos:=tos xor buf(x);                                     <<01869>>03670000
      end                                                      <<01869>>03675000
   until (x:=x-1) < 0;                                         <<01869>>03680000
   buf(cksum):=tos;                                            <<01869>>03685000
                                                               <<01869>>03690000
   << need to make sure this record gets out to the new file >><<01869>>03695000
   << as soon as possible - in case of system crash, etc.    >><<01869>>03700000
                                                               <<01869>>03705000
   flush(null,false);                                          <<01869>>03710000
   checkmsg;                                                   <<01869>>03715000
   end;      << subroutine format'first'file >>                <<01869>>03720000
$page  "Logging Process -- Format'Next'File"                   <<01869>>03725000
subroutine format'next'file;                                   <<01869>>03730000
begin                                                          <<01869>>03735000
<< formats the last record in the current log file upon a    >><<01869>>03740000
<< a changelog. this record will provide linkage to the next >><<01869>>03745000
<< log file in the set.                                      >><<01869>>03750000
                                                               <<01869>>03755000
   << if this is the last extent in the disc log file, make  >><<01869>>03760000
   << the last record free now.                              >><<01869>>03765000
                                                               <<01869>>03770000
                                                               <<01869>>03775000
  if not free'last'extent then                                 <<01869>>03780000
  begin                                                        <<01869>>03785000
   if logbuff(extent) = logbuff(lastext') and q'oldtype = disc <<01869>>03790000
      and dlogbuff(fspace') < double(blkfactor) then                    03795000
      begin                                                    <<01869>>03800000
      dlogbuff(fsize):=dlogbuff(fsize)+1d;                     <<01869>>03805000
      dlogbuff(fspace'):=dlogbuff(fspace')+1d;                 <<01869>>03810000
      logbuff(bspace):=logbuff(bspace)+1;                               03815000
      free'last'extent:=true;                                           03820000
      end;                                                     <<01869>>03825000
  end;                                                         <<01869>>03830000
                                                               <<01869>>03835000
<< correct buffer for partial writes caused by flushes. want >><<01869>>03840000
<< to always make sure that we have complete blocks in the   >><<01869>>03845000
<< log file when it gets closed.                             >><<01869>>03850000
                                                               <<01869>>03855000
                                                               <<01869>>03860000
   dtemp := (dlogbuff(trecs)-dlogbuff(recs'in'prev))/          <<01869>>03865000
          double(blkfactor);                                   <<01869>>03870000
   dtemp:=dtemp*double(blkfactor);                             <<01869>>03875000
   j:=integer((dlogbuff(trecs)-dlogbuff(recs'in'prev))-dtemp); <<01869>>03880000
   j:=blkfactor-j;                                             <<01869>>03885000
   if logbuff(bspace) < logical(j)  then                       <<01869>>03890000
      begin                                                    <<01869>>03895000
      flush(null,false);  << tell it we are the log process >> <<01869>>03900000
      checkmsg;                                                <<01869>>03905000
      end;                                                     <<01869>>03910000
                                                               <<01869>>03915000
   @buf := bufbase + logbuff(bufused)*recsize;                 <<01869>>03920000
   @dbuf:=@buf;                                                <<01869>>03925000
   @bbuf:=2*@buf;                                              <<01869>>03930000
   buf := "  ";                                                <<01869>>03935000
   move buf(1) := buf, (logbuff(bspace)*recsize-1);            <<01869>>03940000
   logbuff(bspace):=logbuff(bspace)-logical(j);                <<01869>>03945000
   logbuff(bufused) := logbuff(bufused) + logical(j);          <<01869>>03950000
                                                               <<01869>>03955000
   << will fill the buffer with null records. the last record>><<01869>>03960000
   << will be the changelog record.                          >><<01869>>03965000
                                                               <<01869>>03970000
   do                                                          <<01869>>03975000
      begin                                                    <<01869>>03980000
      dbuf(rnum):=dlogbuff(trecs):=dlogbuff(trecs)+1d;         <<01869>>03985000
      buf(date):=calendar;                                     <<01869>>03990000
      dbuf(time):=clock;                                       <<01869>>03995000
      if j = 1 then                                            <<01869>>04000000
         begin                                                 <<01869>>04005000
         buf(code):=next'code;                                 <<01869>>04010000
         move bbuf(lid') := blogbuff(logid), (8);              <<01869>>04015000
         buf(date):=calendar;                                  <<01869>>04020000
         dbuf(time):=clock;                                    <<01869>>04025000
         buf(seq):=logbuff(vsetno);                            <<01869>>04030000
         move bbuf(c'file'name):=blogbuff(current'file),(35);  <<01869>>04035000
         move bbuf(f'file'name):=blogbuff(first'file),(35);    <<01869>>04040000
         move bbuf(p'file'name):=blogbuff(next'file),(35);     <<01869>>04045000
         buf(f'file'type):=logbuff(f'type);                    <<01869>>04050000
         buf(p'file'type):=logbuff(n'type);                    <<01869>>04055000
         buf(c'file'type):=logbuff(c'type);                    <<01869>>04060000
         dbuf(c'time):=dlogbuff(first'c'time);                 <<01869>>04065000
         buf(c'date):=logbuff(first'c'date);                   <<01869>>04070000
         end;                                                  <<01869>>04075000
      x := recsizem1;                                          <<01869>>04080000
      tos:=-1;                                                 <<01869>>04085000
      do                                                       <<01869>>04090000
         begin                                                 <<01869>>04095000
         if x <> cksum then                                    <<01869>>04100000
         tos:=tos xor buf(x);                                  <<01869>>04105000
         end until (x:=x-1) < 0;                               <<01869>>04110000
      buf(cksum):=tos;                                         <<01869>>04115000
      @buf := @dbuf := @buf + recsize;                         <<01869>>04120000
      @bbuf:=2*@buf;                                           <<01869>>04125000
      end until (j:=j-1) <= 0;                                 <<01869>>04130000
                                                               <<01869>>04135000
   flush(null,false);                                          <<01869>>04140000
   checkmsg;                                                   <<01869>>04145000
   end;  << subroutine format'next'file >>                     <<01869>>04150000
$page "Logging Process -- CheckRecord"                         <<01869>>04155000
subroutine checkrecord;                                                 04160000
begin                                                                   04165000
                                                                        04170000
<< validates the individual record format (passed by       >>  <<01869>>04175000
<< checkblock) to see if it's in the format of a user      >>  <<01869>>04180000
<< logging record. db at logbuff. used when re-reading the >>  <<01869>>04185000
<< log file to find out where it left off before it was last>>          04190000
<< closed.                                                  >>          04195000
<<                                                          >>          04200000
<<   entry:                                                 >>          04205000
<<     recptr - ptr to the current record in the block.     >>          04210000
<<                                                          >>          04215000
<<   exit:                                                  >>          04220000
<<     valid  - true if record is o.k.                      >>          04225000
<<     currrec- total number of good records found so far.  >>          04230000
<<     last'rec'found - code field from the last good rec.  >>          04235000
                                                                        04240000
                                                                        04245000
                                                                        04250000
valid:=true;                                                            04255000
tos := -1;                                                              04260000
x := recsizem1;                                                <<01869>>04265000
do                                                                      04270000
   begin                                                                04275000
   if x <> cksum then                                                   04280000
   tos := tos xor recptr(x);                                            04285000
   end                                                                  04290000
until (x := x-1) < 0;                                                   04295000
                                                                        04300000
currrec := currrec + 1d;                                                04305000
                                                                        04310000
if tos <> recptr(cksum) then                                            04315000
   begin                                                                04320000
   valid := false;                                             <<01869>>04325000
   end                                                                  04330000
else                                                                    04335000
   begin <<cksum ok>>                                                   04340000
   if currrec = 1d and recptr(code) = first'code then          <<01869>>04345000
      begin                                                    <<01869>>04350000
      currrec:=drecptr(rnum);                                  <<01869>>04355000
      dlogbuff(recs'in'prev):=currrec-1d;                      <<01869>>04360000
      <<set up file entries in log com area>>                  <<01869>>04365000
      move blogbuff(previous'file):=brecptr(p'file'name),(35); <<01869>>04370000
      logbuff(p'type):=recptr(p'file'type);                    <<01869>>04375000
      move blogbuff(current'file):=brecptr(c'file'name),(35);  <<01869>>04380000
      logbuff(c'type):=recptr(c'file'type);                    <<01869>>04385000
      move blogbuff(first'file):=brecptr(f'file'name),(35);    <<01869>>04390000
      logbuff(f'type):=recptr(f'file'type);                    <<01869>>04395000
      dlogbuff(first'c'time):=drecptr(c'time);                 <<01869>>04400000
      logbuff(first'c'date):=recptr(c'date);                   <<01869>>04405000
      logbuff(vsetno) := q'vsetno := recptr(seq);              <<01869>>04410000
      end                                                      <<01869>>04415000
   else                                                        <<01869>>04420000
      if currrec <> drecptr(rnum) then valid:=false;                    04425000
   end;                                                        <<01869>>04430000
                                                                        04435000
                                                                        04440000
                                                               <<01869>>04445000
   if recptr(code).(8:8) = open  then                          <<01869>>04450000
   if logbuff(userno) <= recptr(lnum)                          <<01869>>04455000
      then logbuff(userno) := recptr(lnum) + 1;                <<01869>>04460000
   last'rec'code := recptr(code).(8:8);                        <<01869>>04465000
                                                               <<01869>>04470000
                                                                        04475000
end;   << subroutine checkrecord >>                                     04480000
$page "Logging Process -- CheckBlock"                          <<01869>>04485000
subroutine checkblock;                                                  04490000
begin                                                                   04495000
                                                                        04500000
                                                                        04505000
<< validates the block of log records read while restarting. >><<01869>>04510000
<< db at logbuff.                                            >>         04515000
<<                                                           >>         04520000
<<  entry:                                                   >>         04525000
<<    recptr - ptr to first record of the block.             >>         04530000
<<                                                           >>         04535000
<<  exit:                                                    >>         04540000
<<    i      - # good records found in the block.            >>         04545000
<<    recptr - ptr to last good record + 1.                  >>         04550000
<<    valid  - true if all records o.k. in the block.        >>         04555000
                                                                        04560000
                                                                        04565000
valid := true;                                                          04570000
i := 0;                                                                 04575000
do                                                                      04580000
   begin                                                                04585000
   checkrecord;                                                         04590000
   if valid then                                                        04595000
      begin                                                             04600000
      @recptr := @recptr + recsize;                            <<01869>>04605000
      @drecptr := @recptr;                                              04610000
      @brecptr:=2*@recptr;                                     <<01869>>04615000
      end;                                                              04620000
   end                                                                  04625000
until not valid or (i:=i+1) >= blkfactor;                               04630000
                                                                        04635000
end;   << subroutine checkblock >>                                      04640000
$page "Logging Process -- WakeUp'"                             <<01869>>04645000
subroutine wakeup';                                                     04650000
                                                                        04655000
                                                                        04660000
<< wakes up any sleeping user processes after a request >>              04665000
<< for service has been completed. db at logbuff. will  >>              04670000
<< loop thru the user entries of the logbuff and  wake  >>              04675000
<< up any sleeping user processes until the slpcnt is   >>              04680000
<< zero. these users were put to sleep by flush which   >>     <<01869>>04685000
<< in turn is called from the user logging intrinsics.  >>     <<01869>>04690000
<< db at logbuff.                                       >>     <<01869>>04695000
                                                                        04700000
                                                                        04705000
begin                                                                   04710000
                                                                        04715000
<< any user processes waiting ?? >>                                     04720000
                                                                        04725000
index:=logbuff(uhead);                                                  04730000
while logbuff(slpct) > 0 do                                             04735000
   begin                                                                04740000
   if logbuff(wstate)=inact then                                        04745000
      begin                                                             04750000
      awake(logbuff(upin),%20,0);                                       04755000
      logbuff(wstate):=act;                                             04780000
      logbuff(slpct):=logbuff(slpct)-1;                                 04785000
      end;                                                              04790000
   index:=logbuff(nentry);                                              04795000
   if index = null then index:=logbuff(uhead);                          04800000
   end;                                                                 04805000
                                                                        04810000
end;   << subroutine wakeup' >>                                         04815000
$page "Logging Process -- GetFname"                            <<01869>>04820000
subroutine getfname;                                           <<01869>>04825000
                                                               <<01869>>04830000
<< gets logging file name from the lidtab. db at stack.      >><<01869>>04835000
<< used only for starting/restarting log files - not during  >><<01869>>04840000
<< a changelog.                                              >><<01869>>04845000
<<                                                           >>         04850000
<< exit:                                                     >>         04855000
<<   fname - log file name.                                  >>         04860000
<<   allow'changelog - true if :changelog is allowed.          <<01869>>04865000
                                                               <<01869>>04870000
begin                                                          <<01869>>04875000
                                                               <<01869>>04880000
fname := 0;                                                    <<01869>>04885000
move fname(1) := fname, (35);                                  <<01869>>04890000
fentry(bentry'(lgname),,fname,,,i);                            <<01869>>04895000
if entry'(lgtype)<>disc then fname(8):=0;                      <<01869>>04900000
                                                               <<01869>>04905000
allow'changelog := i.typ'allow'change;                         <<01869>>04910000
                                                               <<01869>>04915000
end;   << subroutine getfname >>                               <<01869>>04920000
$page  "Logging Process -- AbEnd"                              <<01869>>04925000
subroutine abend(msg',logging'type,type);                      <<01869>>04930000
   value msg',logging'type,type;                               <<01869>>04935000
   integer msg',logging'type,type;                             <<01869>>04940000
begin                                                          <<01869>>04945000
                                                               <<01869>>04950000
<< called when an error occurs when starting/restarting or  >> <<01869>>04955000
<< changing log files. db at stack.                         >> <<01869>>04960000
                                                               <<01869>>04965000
del'lockword(fname);  << no lockword for messages >>           <<01869>>04970000
                                                               <<01869>>04975000
                                                               <<01869>>04980000
ulerrcode := msg';                                             <<01869>>04985000
case type of                                                   <<01869>>04990000
   begin                                                       <<01869>>04995000
   << 0 >> genmsg(setno,msg',,,,,,,0);                         <<01869>>05000000
   << 1 >> genmsg(setno,msg',0,@procname,,,,,0);               <<01869>>05005000
   << 2 >> genmsg(setno,msg',0,@fname,@procname,,,,0);         <<01869>>05010000
   << 3 >> genmsg(setno,msg',0,@bfname,@procname,,,,0);        <<01869>>05015000
   << 4 >> genmsg(setno,msg',0,@procname,@old'file'name,,,,0); <<01869>>05020000
   end;                                                        <<01869>>05025000
                                                               <<01869>>05030000
if switch'flag then                                            <<01869>>05035000
   begin                                                       <<01869>>05040000
   del;         << remove return address >>                    <<01869>>05045000
   go changelog'error'recovery;                                <<01869>>05050000
   end;                                                        <<01869>>05055000
                                                               <<01869>>05060000
relentry(tabindex',0);     << get rid of logtab entry >>       <<01869>>05065000
relsir(logsir,a);                                              <<01869>>05070000
                                                               <<01869>>05075000
fclose(fileno,0,0);                                            <<01869>>05080000
if logging'type <> disc then                                   <<01869>>05085000
   fclose(buffileno,4,0);    << delete buffer file >>          <<01869>>05090000
                                                               <<01869>>05095000
if restart' then                                               <<01869>>05100000
   msgno := cantrestart                                        <<01869>>05105000
else                                                           <<01869>>05110000
   msgno := cantstart;                                         <<01869>>05115000
                                                               <<01869>>05120000
del;            << get rid of return address >>                <<01869>>05125000
go out;                                                        <<01869>>05130000
                                                               <<01869>>05135000
end;     << subroutine abend >>                                <<01869>>05140000
                                                               <<01869>>05145000
$page "Logging Process -- AbEnd'"                              <<01869>>05150000
subroutine abend'(msg',fnum,logging'type,type);                <<01869>>05155000
   value msg',fnum,logging'type,type;                          <<01869>>05160000
   integer msg',fnum,logging'type,type;                        <<01869>>05165000
begin                                                          <<01869>>05170000
                                                               <<01869>>05175000
<< same as abend, but also prints the file system error.     >><<01869>>05180000
                                                               <<01869>>05185000
fcheck(fnum,errcode);                                          <<01869>>05190000
genmsg(fssetno,errcode,,,,,,,0);                               <<01869>>05195000
abend(msg',logging'type,type);                                 <<01869>>05200000
                                                               <<01869>>05205000
end;    << subroutine abend' >>                                <<01869>>05210000
                                                               <<01869>>05215000
$page  "Logging Process -- Open'Serial'Logfile"                <<01869>>05220000
subroutine open'serial'logfile;                                         05225000
begin                                                                   05230000
                                                                        05235000
<< will open a serial log file. if any errors are detected,  >>         05240000
<< will print message to the console and go to out. db at    >>         05245000
<< stack.                                                    >>         05250000
<<                                                           >>         05255000
<<   entry:                                                  >>         05260000
<<     has the logsir.                                       >>         05265000
<<     entry'    - copy of the logtab entry.                 >>         05270000
<<     tabindex' - entry offset within the logtab for entry'.>>         05275000
<<     restart'  - true if currently restarting a log process>>         05280000
<<     switch'flag-true if currently processing a changelog. >>         05285000
<<                                                           >>         05290000
<<   exit:                                                   >>         05295000
<<     dev     - device name where log file resides.         >>         05300000
<<     errcode - if error, file system error number.         >>         05305000
<<     fname   - log file name.                              >>         05310000
<<     fileno  - file number of serial log file.             >>         05315000
<<     tape'   - true if log file on tape device.            >>         05320000
<<     tapedev - ldev # for log file if it's on a tape device>>         05325000
<<     ulerrcode- if error, the user logging error number    >><<01869>>05330000
                                                                        05335000
tape' := false;                                                <<01869>>05340000
notified:=false;                                               <<01869>>05345000
abnormal'exit:=false;                                          <<01869>>05350000
formatted'trailer := false;                                    <<01869>>05355000
free'last'extent := false;                                     <<01869>>05360000
first'tape'block := true;                                      <<01869>>05365000
                                                               <<01869>>05370000
dev := " ";                                                    <<01869>>05375000
move dev(1) := dev, (7);                                       <<01869>>05380000
dev(8) := 0;                                                   <<01869>>05385000
                                                                        05390000
                                                                        05395000
errcode := 0;                                                           05400000
ulerrcode := 0;                                                <<01869>>05405000
   case entry'(lgtype) of                                      <<01869>>05410000
   begin                                                       <<01869>>05415000
   <<0>>  ;         << disc - never get here >>                <<01869>>05420000
                                                                        05425000
   <<1>>  begin    << tape log file >>                         <<01869>>05430000
          move dev := "TAPE ";                                 <<01869>>05435000
          tape' := true;                                       <<01869>>05440000
          end;     << tape log file >>                         <<01869>>05445000
                                                                        05450000
   <<2>>  move dev := "SDISC ";                                <<01869>>05455000
   <<3>>  move dev := "CTAPE ";                                <<01869>>05460000
   end;                                                        <<01869>>05465000
                                                               <<01869>>05470000
if not switch'flag then                                        <<01869>>05475000
   getfname;                                                   <<01869>>05480000
move forms:=".,,,,; ";                                                  05485000
                                                               <<01869>>05490000
if switch'flag then                                            <<01869>>05495000
   genmsg(setno,mount'next,0,@dev,@procname,,,,0);             <<01869>>05500000
                                                               <<01869>>05505000
<< log file is ascii,fixed labeled tape (no :file),default>>   <<01869>>05510000
<< access, read/write, no multi-rec, no buf.                 >><<01869>>05515000
                                                               <<01869>>05520000
fileno := fopen(fname,%3004,%404,recsize,dev,forms,,blkfactor);<<01869>>05525000
if <> then             << open failure >>                               05530000
   begin                                                                05535000
   del'lockword(fname);                                        <<01869>>05540000
   if switch'flag then                                         <<01869>>05545000
      abend'(nlogopenfail,fileno,tape,print'fname)             <<01869>>05550000
   else                                                        <<01869>>05555000
      abend'(topenfailed,fileno,tape,print'fname);             <<01869>>05560000
   end;                                                                 05565000
                                                                        05570000
del'lockword(fname);                                           <<01869>>05575000
ffileinfo(fileno, get'ldev,tapedev);                           <<01869>>05580000
if < then                                                      <<01869>>05585000
   begin                                                       <<01869>>05590000
   if switch'flag then                                         <<01869>>05595000
      abend'(nlogopenfail,fileno,tape,print'fname)             <<01869>>05600000
   else                                                        <<01869>>05605000
      abend'(topenfailed,fileno,tape,print'fname);             <<01869>>05610000
   end;                                                        <<01869>>05615000
                                                               <<01869>>05620000
<< if we're doing a log start to tape, then we want to do >>   <<01869>>05625000
<< a dummy write to force the hdr labels to be written    >>   <<01869>>05630000
<< now. this must be done to protect ourselves from a     >>   <<01869>>05635000
<< powerfail before the hdrs get to tape. the labeled tape>>   <<01869>>05640000
<< interface will never tell the f.s. if it got powerfail,>>   <<01869>>05645000
<< therefore if we wait until we start flushing buffers to>>   <<01869>>05650000
<< tape we will never know if there was a powerfail, and  >>   <<01869>>05655000
<< would never be able to recover. by performing an fwrite>>   <<01869>>05660000
<< now, if we get any error at all, we will not let the   >>   <<01869>>05665000
<< process start.                                         >>   <<01869>>05670000
                                                               <<01869>>05675000
if entry'(lgtype)=tape and ((not restart') lor switch'flag)    <<01869>>05680000
   then                                                        <<01869>>05685000
   begin                                                       <<01869>>05690000
   fwrite(fileno,buffarea,zero'length,normal'write);           <<01869>>05695000
   if <> then                                                  <<01869>>05700000
      begin                                                    <<01869>>05705000
      if switch'flag then                                      <<01869>>05710000
         abend'(newfwriteerror,fileno,tape,print'fname)        <<01869>>05715000
      else                                                     <<01869>>05720000
         abend'(fwriteerror,fileno,tape,print'fname);          <<01869>>05725000
      end;                                                     <<01869>>05730000
   end;                                                        <<01869>>05735000
                                                                        05740000
if not restart' and                                            <<01869>>05745000
   (entry'(lgtype) = sdisc lor entry'(lgtype) = ctape) or      <<01869>>05750000
   (q'newtype = sdisc lor q'newtype = ctape) and switch'flag   <<01869>>05755000
   then                                                        <<01869>>05760000
   begin                                                       <<01869>>05765000
   << need to issue a special write request for the first    >><<01869>>05770000
   << write. this will cause the serial disc interface to    >><<01869>>05775000
   << post an eod marker to the gap table so that recovery   >><<01869>>05780000
   << will be possible in the event of a system crash.       >><<01869>>05785000
                                                               <<01869>>05790000
   fwrite(fileno,buffarea,zero'length,special'write);          <<01869>>05795000
   if <> then                                                  <<01869>>05800000
      begin                                                    <<01869>>05805000
      if switch'flag then                                      <<01869>>05810000
         abend'(newfwriteerror,fileno,tape,print'fname)        <<01869>>05815000
      else                                                     <<01869>>05820000
         abend'(fwriteerror,fileno,tape,print'fname);          <<01869>>05825000
      end;                                                     <<01869>>05830000
   end;                                                        <<01869>>05835000
                                                               <<01869>>05840000
end;       << subroutine open'serial'logfile >>                         05845000
$page "Logging Process -- Open'Buffer'File"                    <<01869>>05850000
subroutine open'buffer'file;                                            05855000
begin                                                                   05860000
                                                               <<01869>>05865000
<< will open a disc buffer file - ulogxxxx.pub.sys to be used>>         05870000
<< with a serial log file. after successfully opening, will  >>         05875000
<< close it to make it a permanent file (need this file for  >>         05880000
<< system crashes in order to perform warmstart recovery).   >>         05885000
<< will then re-open the file, set eof to the file limit (to >>         05890000
<< order to recover the data during recovery). this file will>>         05895000
<< be treated internally as a circular queue. if any errors  >>         05900000
<< are detected, will print message on console and go out.   >>         05905000
<< db at stack.                                              >>         05910000
<<                                                           >>         05915000
<< entry:                                                    >>         05920000
<<   has the logsir.                                         >>         05925000
<<   entry'    - entry from the logtab for this process.     >>         05930000
<<   switch'flag- true if currently processing a changelog.  >>         05935000
<<                                                           >>         05940000
<< exit:                                                     >>         05945000
<<   addr      - sector address of disc buffer file.         >>         05950000
<<   bfname    - disc buffer file name.                      >>         05955000
<<   buffileno - file number of disc buffer file.            >>         05960000
<<   dev       - device name ("DISC").                       >>         05965000
<<   discldev  - ldev for the disc buffer file.              >><<01869>>05970000
<<   dtemp     - # records in disc buffer file.              >>         05975000
<<   entry'    - global values updated.                      >>         05980000
<<   errcode   - if error, file system error number.         >>         05985000
<<   flab      - file label of the disc buffer file.         >>         05990000
<<   flabaddr  - address of file label.                      >><<01869>>05995000
<<   flabldev  - ldev of file label.                         >><<01869>>06000000
<<   limit     - # records in the buffer file.               >>         06005000
<<   numext    - max # extents in disc buffer file (always 1)>>         06010000
<<   temp      - current buffer number.                      >>         06015000
<<   ulerrcode - if error, user logging error number         >><<01869>>06020000
                                                                        06025000
                                                                        06030000
                                                                        06035000
                                                               <<01869>>06040000
   move bfname:="  ";                                                   06045000
   move bfname(1):=bfname,(14);                                         06050000
   move dev:="DISC ";                                          <<01869>>06055000
                                                               <<01869>>06060000
   << format the disc buffer name -- ulogxxxx.pub.sys >>       <<01869>>06065000
                                                               <<01869>>06070000
   move bfname:=bentry'(bname),(8);            <<buffer name>>          06075000
                                                                        06080000
next'bufnum:                                                            06085000
   errcode:=0;                                                 <<01869>>06090000
   ulerrcode := 0;                                             <<01869>>06095000
   move'from'dseg(@temp,logdst,bufnum,1);                      <<01869>>06100000
   temp:=temp+1;                                               <<01869>>06105000
   if temp > 9999 then temp := 0;   << max of 4 chars >>       <<01869>>06110000
   move'to'dseg(logdst,bufnum,@temp,1);                        <<01869>>06115000
                                                               <<01869>>06120000
   << format the buffer file name >>                                    06125000
                                                                        06130000
   move bfname(4):=zeros,(4);                                  <<01869>>06135000
   ascii(temp,-10,bfname(7));                                  <<01869>>06140000
                                                               <<01869>>06145000
   move bfname(8):=".PUB.SYS ";                                         06150000
   move bentry'(bname):=bfname,(8);                                     06155000
                                                                        06160000
   << open a new buffer file >>                                         06165000
                                                                        06170000
                                                               <<01869>>06175000
   << buffer file: ascii, new, fixed, no :file, read/write, >> <<01869>>06180000
   << multi-rec, no buf, exc.                               >> <<01869>>06185000
                                                               <<01869>>06190000
   buffileno := fopen(bfname,%2004,%524,recsize,dev,,,,,       <<01869>>06195000
                      640d,1,1);                               <<01869>>06200000
   if <> then                                                  <<01869>>06205000
      begin                                                             06210000
      fcheck(buffileno,errcode);                                        06215000
      if errcode = dup'filename then                                    06220000
         go next'bufnum                                                 06225000
      else                                                              06230000
         begin                                                          06235000
         if switch'flag then                                   <<01869>>06240000
            abend'(newbopenfail,buffileno,tape,print'bfname)   <<01869>>06245000
         else                                                  <<01869>>06250000
            abend'(bopenfailed,buffileno,tape,print'bfname);   <<01869>>06255000
         end;                                                           06260000
      end;                                                              06265000
                                                                        06270000
   fclose(buffileno,1,0);   << save as a permanent file >>              06275000
   if <> then                                                           06280000
      begin                                                             06285000
      fcheck(buffileno,errcode);                                        06290000
      if errcode = dup'filename                                         06295000
         then go next'bufnum                                            06300000
      else                                                              06305000
         begin                                                          06310000
         if switch'flag then                                   <<01869>>06315000
            abend'(newbopenfail,buffileno,tape,print'bfname)   <<01869>>06320000
         else                                                  <<01869>>06325000
            abend'(bopenfailed,buffileno,tape,print'bfname);   <<01869>>06330000
         end;                                                           06335000
      end;                                                              06340000
                                                               <<01869>>06345000
   buffileno := fopen(bfname,%2005,%524,recsize,dev);          <<01869>>06350000
   if <> then                                                  <<01869>>06355000
      begin                                                             06360000
      if switch'flag then                                      <<01869>>06365000
         abend'(newbopenfail,buffileno,tape,print'bfname)      <<01869>>06370000
      else                                                     <<01869>>06375000
         abend'(bopenfailed,buffileno,tape,print'bfname);      <<01869>>06380000
      end;                                                              06385000
                                                               <<01869>>06390000
   << move file record ptr to last record of the file. >>               06395000
                                                                        06400000
   fwritedir(buffileno,buffarea,recsize,639d);                 <<01869>>06405000
   if <> then                                                  <<01869>>06410000
      begin                                                             06415000
      if switch'flag then                                      <<01869>>06420000
         abend'(newbwriteerror,buffileno,tape,print'bfname)    <<01869>>06425000
      else                                                     <<01869>>06430000
         abend'(bwriteerror,buffileno,tape,print'bfname);      <<01869>>06435000
      end;                                                              06440000
                                                               <<01869>>06445000
   << now set eof to protect any data from system crashes. >>           06450000
                                                                        06455000
   fcontrol(buffileno,set'eof,dummy);                          <<01869>>06460000
   if <> then                                                  <<01869>>06465000
      begin                                                             06470000
      if switch'flag then                                      <<01869>>06475000
         abend'(newbwriteerror,buffileno,tape,print'bfname)    <<01869>>06480000
      else                                                     <<01869>>06485000
         abend'(bwriteerror,buffileno,tape,print'bfname);      <<01869>>06490000
      end;                                                              06495000
                                                               <<01869>>06500000
   fgetinfo(buffileno,,,,,,flabldev,,,,,limit,,,,,,,,flabaddr);<<01869>>06505000
   if <> then                                                  <<01869>>06510000
      begin                                                             06515000
      if switch'flag then                                      <<01869>>06520000
         abend'(newbwriteerror,buffileno,tape,print'bfname)    <<01869>>06525000
      else                                                     <<01869>>06530000
         abend'(bwriteerror,buffileno,tape,print'bfname);      <<01869>>06535000
      end;                                                              06540000
                                                               <<01869>>06545000
   dtemp:=limit;                                               <<01869>>06550000
                                                                        06555000
   << get sector offset to begining of data of the file. >>             06560000
                                                                        06565000
   if flabio(flabldev,flabaddr,read,flab) <> 0  then           <<01869>>06570000
      begin                                                             06575000
      if switch'flag then                                      <<01869>>06580000
         abend(newbwriteerror,tape,print'bfname)               <<01869>>06585000
      else                                                     <<01869>>06590000
         abend(bwriteerror,tape,print'bfname);                 <<01869>>06595000
      end;                                                              06600000
                                                               <<01869>>06605000
                                                               <<01869>>06610000
   numext := 1;                                                <<01869>>06615000
   extnum := 1;                                                <<01869>>06620000
   addr := dflab(21+extnum);                                   <<01869>>06625000
   discldev := flabldev;                                       <<01869>>06630000
   addr1.(0:8) := 0;         << get rid of ldev >>             <<01869>>06635000
   addr := addr + double(flab(offset'to'data));                <<01869>>06640000
   entry'(lgdev) := discldev;                                  <<01869>>06645000
   dentry'(lgaddr):=addr;                                               06650000
   move bentry'(bname) := bfname, (8);                         <<01869>>06655000
end;       << subroutine open'buffer'file >>                            06660000
$page  "Logging Process -- Open'Disc'Logfile"                  <<01869>>06665000
subroutine open'disc'logfile;                                           06670000
begin                                                                   06675000
                                                                        06680000
<< will open the specified disc log file. this file must have>>         06685000
<< been built by the user prior to (re)starting this log     >>         06690000
<< process. will extract various info - # extents, extent    >>         06695000
<< size, disc address, etc. - that will be used by this log  >>         06700000
<< process to manage the file. db is at stack.               >>         06705000
<<                                                           >>         06710000
<<                                                           >>         06715000
<< entry:                                                    >>         06720000
<<   has logsir.                                             >>         06725000
<<   entry'   - entry from the logtab for this log process.  >>         06730000
<<   restart' - true if currently restarting the log process.>>         06735000
<<   tabindex'- entry offset within the logtab for this entry>>         06740000
<<                                                           >>         06745000
<< exit:                                                     >>         06750000
<<   addr     - disc address of current extent.              >>         06755000
<<   blocknum - last block of the current extent.            >>         06760000
<<   discldev - ldev for current extent.                     >><<01869>>06765000
<<   dtemp    - # records in extent.                         >>         06770000
<<   extnum   - current extent number.                       >>         06775000
<<   fname    - name of this log file.                       >>         06780000
<<   flab     - file label of disc log file.                 >>         06785000
<<   flabaddr - address of file label.                       >><<01869>>06790000
<<   flabldev - ldev of file label.                          >><<01869>>06795000
<<   fileno   - file number of the disc log file.            >>         06800000
<<   numext   - max # of extents.                            >>         06805000
<<   ulerrcode- if error, user logging error number          >><<01869>>06810000
                                                               <<01869>>06815000
                                                                        06820000
tape' := false;                                                <<01869>>06825000
notified:=false;                                               <<01869>>06830000
abnormal'exit:=false;                                          <<01869>>06835000
formatted'trailer := false;                                    <<01869>>06840000
free'last'extent := false;                                     <<01869>>06845000
                                                                        06850000
dev := " ";                                                    <<01869>>06855000
move dev(1) := dev, (7);                                       <<01869>>06860000
dev(8) := 0;                                                   <<01869>>06865000
                                                                        06870000
errcode := 0;                                                           06875000
ulerrcode := 0;                                                <<01869>>06880000
                                                               <<01869>>06885000
   move dev:="DISC ";                                                   06890000
   if not switch'flag then getfname;                           <<01869>>06895000
                                                                        06900000
   << disc log file: ascii, old, no :file, read/write, ear,  >>         06905000
   <<                mr, nobuf.                              >>         06910000
                                                                        06915000
   if not switch'flag then                                     <<01869>>06920000
   begin                                                       <<01869>>06925000
   fileno := fopen(fname,%2005,%624,recsize,dev,,,blkfactor);  <<01869>>06930000
   if <> then                                                           06935000
      begin                                                             06940000
      del'lockword(fname);                                     <<01869>>06945000
      if switch'flag then                                      <<01869>>06950000
        abend'(nlogopenfail,fileno,disc,print'fname)           <<01869>>06955000
      else                                                     <<01869>>06960000
         abend'(uopenfailed,fileno,disc,print'fname);          <<01869>>06965000
      end;                                                              06970000
      end                                                      <<01869>>06975000
   else                                                        <<01869>>06980000
      begin                                                    <<01869>>06985000
                                                               <<01869>>06990000
      << performing a changelog >>                             <<01869>>06995000
                                                               <<01869>>07000000
      exchangedb(bufdst);                                      <<01869>>07005000
      if q'oldtype <> disc then                                <<01869>>07010000
         limit := default'limit d                              <<01869>>07015000
      else                                                     <<01869>>07020000
         limit := dlogbuff(old'limit);                         <<01869>>07025000
                                                               <<01869>>07030000
      if q'oldtype <> disc then                                <<01869>>07035000
         numext := default'numext                              <<01869>>07040000
      else                                                     <<01869>>07045000
         numext := logbuff(old'numext);                        <<01869>>07050000
      exchangedb(0);                                           <<01869>>07055000
                                                               <<01869>>07060000
try'smaller'size'on'changelog:                                 <<01869>>07065000
                                                               <<01869>>07070000
      fileno:=fopen(fname, %2004,%624,recsize,                 <<01869>>07075000
              dev,,,blkfactor,no'buf,limit,numext,,log);       <<01869>>07080000
      if <> then                                               <<01869>>07085000
         begin                                                 <<01869>>07090000
         fcheck(fileno,errcode);                               <<01869>>07095000
         if errcode = out'of'account'space or                  <<01869>>07100000
            errcode = out'of'group'space then                  <<01869>>07105000
            begin                                              <<01869>>07110000
            limit := limit/2d;                                 <<01869>>07115000
            if limit >= lowest'limit d then                    <<01869>>07120000
               go try'smaller'size'on'changelog;               <<01869>>07125000
            abend'(newdiscspace,fileno,disc,print'fname);      <<01869>>07130000
            end;                                               <<01869>>07135000
         abend'(nlogopenfail,fileno,disc,print'fname);         <<01869>>07140000
         end;                                                  <<01869>>07145000
                                                               <<01869>>07150000
         << make the new log file permenate >>                 <<01869>>07155000
                                                               <<01869>>07160000
         logclose(fileno,1,0);                                 <<01869>>07165000
         if <> then                                            <<01869>>07170000
            begin                                              <<01869>>07175000
            abend'(newlogclosefail,fileno,disc,print'fname);   <<01869>>07180000
            end;                                               <<01869>>07185000
                                                               <<01869>>07190000
         << now reopen the file to see what we got.          >><<01869>>07195000
                                                               <<01869>>07200000
         fileno:=fopen(fname,%2005,%624,recsize,dev,,,blkfactor);       07205000
         if <> then                                            <<01869>>07210000
            begin                                              <<01869>>07215000
            abend'(nlogopenfail,fileno,disc,print'fname);      <<01869>>07220000
            end;                                               <<01869>>07225000
      end;                                                     <<01869>>07230000
                                                               <<01869>>07235000
del'lockword(fname);                                           <<01869>>07240000
   if switch'flag then                                         <<01869>>07245000
      begin                                                    <<01869>>07250000
      exchangedb(bufdst);                                      <<01869>>07255000
      dlogbuff(old'limit):=limit;                              <<01869>>07260000
      logbuff(old'numext):=numext;                             <<01869>>07265000
      logbuff(lastext'):=numext;                               <<01869>>07270000
      exchangedb(0);                                           <<01869>>07275000
      end;                                                     <<01869>>07280000
   fgetinfo(fileno,,,,,,flabldev,,,,,                          <<01869>>07285000
            limit,,,,extsize,numext,,,flabaddr);               <<01869>>07290000
   if <> then                                                  <<01869>>07295000
      begin                                                             07300000
      if switch'flag then                                      <<01869>>07305000
         abend'(newfwriteerror,fileno,disc,print'fname)        <<01869>>07310000
      else                                                     <<01869>>07315000
         abend'(fwriteerror,fileno,disc,print'fname);          <<01869>>07320000
      end;                                                     <<01869>>07325000
                                                               <<01869>>07330000
                                                               <<01869>>07335000
   flabaddr1.(0:8) := 0;       << get rid of ldev >>           <<01869>>07340000
   if flabio(flabldev,flabaddr,read,flab) <> 0 then            <<01869>>07345000
      begin                                                             07350000
      if switch'flag then                                      <<01869>>07355000
         abend(newflaberror,disc,print'fname)                  <<01869>>07360000
      else                                                     <<01869>>07365000
         abend(flabelerr,disc,print'fname);                    <<01869>>07370000
      end;                                                              07375000
                                                               <<01869>>07380000
   if (dflab(eof) <> 0d) and (not restart') then               <<01869>>07385000
     begin                 << can't start >>                   <<01869>>07390000
     abend(notempty,disc,print'fname);                         <<01869>>07395000
     return;                                                            07400000
     end;                                                               07405000
                                                               <<01869>>07410000
   if restart' and (dflab(eof) >= dflab(flimit) - 1d) then     <<01869>>07415000
     begin                                                     <<01869>>07420000
     if switch'flag then                                       <<01869>>07425000
        abend(newlogeof,disc,print'fname)                      <<01869>>07430000
     else                                                      <<01869>>07435000
        abend(logfileeof,disc,print'fname);                    <<01869>>07440000
     end;                                                               07445000
                                                               <<01869>>07450000
   if flab(fcode) <> log then                                  <<01869>>07455000
      begin                                                             07460000
      abend(invalidfile,disc,print'fname);                     <<01869>>07465000
      return;                                                           07470000
      end;                                                              07475000
                                                               <<01869>>07480000
   if flab(fblksize) <> blksize then                           <<01869>>07485000
      begin                                                    <<01869>>07490000
      abend(invalidfile,disc,print'fname);                     <<01869>>07495000
      return;                                                           07500000
      end;                                                              07505000
                                                               <<01869>>07510000
   if dflab(flimit) <= double(blkfactor) then                  <<01869>>07515000
     begin                <<file too small>>                   <<01869>>07520000
     if switch'flag then                                       <<01869>>07525000
        abend(new'too'small,disc,print'fname)                  <<01869>>07530000
     else                                                      <<01869>>07535000
        abend(toosmall,disc,print'fname);                      <<01869>>07540000
     end;                                                               07545000
                                                               <<01869>>07550000
   << make sure that the creator of the previous file is also>><<01869>>07555000
   << the creator of this file.                              >><<01869>>07560000
                                                               <<01869>>07565000
   if switch'flag then                                         <<01869>>07570000
      begin                                                    <<01869>>07575000
      move bflab(creator'id):=" ";                             <<01869>>07580000
      move bflab(creator'id):=bflab(creator'id),(7);           <<01869>>07585000
   fentry'switch(bentry'(lgname),,,bflab(creator'id));         <<01869>>07590000
      flab(f'cksum):=0;                                        <<01869>>07595000
      if flabio(flabldev,flabaddr,write,flab) <> 0 then        <<01869>>07600000
         begin                                                 <<01869>>07605000
         abend(newflaberror,disc,print'fname);                 <<01869>>07610000
                                                               <<01869>>07615000
         end;                                                  <<01869>>07620000
      end;                                                     <<01869>>07625000
                                                               <<01869>>07630000
   << the first block will be used up by the file label.    >> <<01869>>07635000
                                                               <<01869>>07640000
   dtemp := double(extsize) - double(blkfactor);               <<01869>>07645000
                                                               <<01869>>07650000
   << want to leave the last record of the last extent free,>> <<01869>>07655000
   << for now, to insure there will be room in the file so  >> <<01869>>07660000
   << proper close information can get posted.              >> <<01869>>07665000
                                                               <<01869>>07670000
   if numext = 1 then                                          <<01869>>07675000
      begin           << last extent >>                        <<01869>>07680000
      dtemp := dtemp - 1d;                                     <<01869>>07685000
                                                               <<01869>>07690000
      << check to see if there's room to do this.           >> <<01869>>07695000
      if dtemp <= 0d then                                      <<01869>>07700000
         begin                                                 <<01869>>07705000
         if switch'flag then                                   <<01869>>07710000
            abend(new'too'small,disc,print'fname)              <<01869>>07715000
         else                                                  <<01869>>07720000
            abend(toosmall,disc,print'fname);                  <<01869>>07725000
         end;                                                  <<01869>>07730000
                                                               <<01869>>07735000
      end;                                                     <<01869>>07740000
                                                               <<01869>>07745000
                                                               <<01869>>07750000
   if not restart' then                                                 07755000
      begin                                                             07760000
      << allocate the first extent to be used for data.      >><<01869>>07765000
      << calculate the last block number in the extent -     >><<01869>>07770000
      << move the eof ptr. here.  (fwritedir, fcontrol)      >><<01869>>07775000
                                                               <<01869>>07780000
      blocknum := double((extsize-blkfactor)/blkfactor) -1d;   <<01869>>07785000
      if blocknum < 0d  then blocknum := 0d;                   <<01869>>07790000
                                                               <<01869>>07795000
      fwritedir(fileno,buffarea,recsize,blocknum);             <<01869>>07800000
      if <> then                                               <<01869>>07805000
         begin                                                          07810000
         if switch'flag then                                   <<01869>>07815000
            abend'(newfwriteerror,fileno,disc,print'fname)     <<01869>>07820000
         else                                                  <<01869>>07825000
            abend'(fwriteerror,fileno,disc,print'fname);       <<01869>>07830000
         end;                                                           07835000
                                                                        07840000
      fcontrol(fileno,set'eof,dummy);                          <<01869>>07845000
      if <> then                                               <<01869>>07850000
         begin                                                          07855000
         if switch'flag then                                   <<01869>>07860000
            abend'(newfwriteerror,fileno,disc,print'fname)     <<01869>>07865000
         else                                                  <<01869>>07870000
            abend'(fwriteerror,fileno,disc,print'fname);       <<01869>>07875000
         end;                                                           07880000
                                                               <<01869>>07885000
      << if the first extent is the same size as the         >><<01869>>07890000
      << blocksize, then the above fwritedir will actually   >><<01869>>07895000
      << force the file system to allocate the 2nd extent.   >><<01869>>07900000
      << (the first block would have been used up by the file>><<01869>>07905000
      << label). if this has happened, need to re-read the   >><<01869>>07910000
      << the file label to get the disc address of the 2nd   >><<01869>>07915000
      << extent (and it's ldev).                             >><<01869>>07920000
                                                               <<01869>>07925000
      if extsize <= blkfactor then                             <<01869>>07930000
         begin                                                 <<01869>>07935000
         if flabio(flabldev,flabaddr,read,flab) <> 0 then      <<01869>>07940000
            begin                                              <<01869>>07945000
            if switch'flag then                                <<01869>>07950000
               abend(newflaberror,disc,print'fname)            <<01869>>07955000
            else                                               <<01869>>07960000
               abend(flabelerr,disc,print'fname);              <<01869>>07965000
            end;                                               <<01869>>07970000
                                                               <<01869>>07975000
         extnum := 2;                                          <<01869>>07980000
         if extnum = numext then                               <<01869>>07985000
            dtemp := double(flab(lastext)) - 1d                <<01869>>07990000
         else                                                  <<01869>>07995000
            dtemp := double(flab(fextsize));                   <<01869>>08000000
                                                               <<01869>>08005000
         addr := dflab(21+extnum);                             <<01869>>08010000
         discldev := lun(addr1.(0:8),fgetpvinfo(fileno).(4:4));<<01869>>08015000
         addr1.(0:8) := 0;      << get rid of ldev >>          <<01869>>08020000
         end                                                   <<01869>>08025000
      else                                                     <<01869>>08030000
         begin                                                 <<01869>>08035000
         << this is the normal case, where the extent size is ><<01869>>08040000
         << bigger than the block size.                       ><<01869>>08045000
                                                               <<01869>>08050000
         extnum := 1;                                          <<01869>>08055000
         addr := dflab(21+extnum);                             <<01869>>08060000
         discldev := flabldev;                                 <<01869>>08065000
         addr1.(0:8) := 0;     << get rid of ldev >>           <<01869>>08070000
         addr := addr + double(flab(offset'to'data));          <<01869>>08075000
                                                               <<01869>>08080000
         if extnum = numext then                               <<01869>>08085000
            begin                                              <<01869>>08090000
            << file hase only 1 extent,save the last extent>>  <<01869>>08095000
            <<for either trailer record or changelog record>>  <<01869>>08100000
            dtemp := double(flab(lastext))-1d;                 <<01869>>08105000
            end                                                <<01869>>08110000
         else                                                  <<01869>>08115000
            dtemp := double(flab(fextsize));                   <<01869>>08120000
            << if were on the first extent, the first block>>  <<01869>>08125000
            << of the first extent will be used for the    >>  <<01869>>08130000
            << file label.                                 >>  <<01869>>08135000
            if extnum = 1 then                                 <<01869>>08140000
               dtemp := dtemp - double(blkfactor);             <<01869>>08145000
                                                               <<01869>>08150000
         end;                                                  <<01869>>08155000
      end;   << not restarting the log process >>                       08160000
                                                               <<01869>>08165000
   << if the log process is being restarted, then when the   >><<01869>>08170000
   << log file is re-read, the information about the current >><<01869>>08175000
   << extent, address, etc will be calculated.               >><<01869>>08180000
                                                               <<01869>>08185000
                                                               <<01869>>08190000
end;         << subroutine open'disc'logfile >>                         08195000
$page "Logging Process -- Open'Logfile"                        <<01869>>08200000
subroutine open'logfile;                                                08205000
begin                                                                   08210000
                                                                        08215000
<< will clear important global variables, get the entry from >>         08220000
<< the logtab for this process, and call the proper subrout. >>         08225000
<< to open the specified log file. db at stack.              >>         08230000
<<                                                           >>         08235000
<< entry:                                                    >>         08240000
<<   tabindex' - entry offset within logtab for this entry.  >>         08245000
<<                                                           >>         08250000
<< exit:                                                     >>         08255000
<<   has the logsir.                                         >>         08260000
<<   a         - return form getsir.                         >>         08265000
<<   entry'    - entry from the logtab for this process.     >>         08270000
<<   procname  - logid for this process.                     >>         08275000
                                                                        08280000
                                                                        08285000
index:=0;                                                               08290000
tabindex:=0;         <<set tabindex for temp entry just read>>          08295000
if not switch'flag then q'vsetno := 1;                         <<01869>>08300000
                                                                        08305000
a:=getsir(logsir);                                                      08310000
move'from'dseg(@entry',logdst,tabindex',tentrysize);           <<01869>>08315000
move procname:=bentry'(lgname),(8);                            <<01869>>08320000
procname(8):=0;                                                         08325000
                                                               <<01869>>08330000
if entry'(lgtype) <> disc  then                                <<01869>>08335000
   begin                     << serial log file - file opens >><<01869>>08340000
   open'serial'logfile;                                                 08345000
   open'buffer'file;                                                    08350000
   end                                                                  08355000
else                                                                    08360000
  open'disc'logfile;                                                    08365000
                                                                        08370000
end;           << subroutine open'new'log'file >>                       08375000
$page "Logging Process -- Find'Last'Record"                    <<01869>>08380000
subroutine find'last'record;                                            08385000
begin                                                                   08390000
                                                                        08395000
<< will re-read the log file to find the last valid record   >>         08400000
<< from the last time the log file was opened. db at logbuff.>>         08405000
<<                                                           >>         08410000
<< entry:                                                    >>         08415000
<<   buf       - ptr to buffer area of logbuff.              >>         08420000
<<                                                           >>         08425000
<< exit:                                                     >>         08430000
<<   currrec   - current record number.                      >>         08435000
<<   eoforerror- true to terminate read loop.                >>         08440000
<<   lastrec   - last good record found.                     >>         08445000
<<   last'rec'code - set by checkblock.                      >>         08450000
<<   valid     - set by checkblock (true if block was good). >>         08455000
                                                                        08460000
                                                                        08465000
                                                                        08470000
   eoforerr:=false;                                                     08475000
   currrec:=0d;                                                         08480000
   lastrec:=0d;                                                         08485000
                                                                        08490000
   do                                                                   08495000
      begin                                                             08500000
                                                                        08505000
   << read and check old info in the file. will read until an>>         08510000
   << i/o error, bad block, or eof is detected.              >>         08515000
                                                                        08520000
      @recptr:=@buf;                                                    08525000
      @drecptr:=@buf;                                                   08530000
      @brecptr:=2*@buf;                                        <<01869>>08535000
      count:=fread(fileno,buf,blksize);                                 08540000
      if <> then                                                        08545000
         begin                                                          08550000
         if < then     << error ? >>                                    08555000
            begin                                                       08560000
            fcheck(fileno,errcode);                                     08565000
            fspace(fileno,-1);                                          08570000
            exchangedb(0);   << back to stack >>                        08575000
            genmsg(fssetno,errcode,,,,,,,0);                   <<01869>>08580000
            genmsg(setno,readerr,0,@procname,,,,,0);           <<01869>>08585000
            exchangedb(bufdst);    << to logbuff >>                     08590000
            end;                                                        08595000
         eoforerr:=true;                                                08600000
         end;             << error detected >>                          08605000
                                                                        08610000
      if count <> blksize then eoforerr := true;                        08615000
                                                                        08620000
      checkblock;                                                       08625000
      if valid then                                                     08630000
         begin                                                          08635000
         @recptr:=@recptr-recsize;                             <<01869>>08640000
         @drecptr:=@recptr;                                             08645000
         @brecptr:=2*@recptr;                                  <<01869>>08650000
         lastrec:=drecptr(rnum);                                        08655000
         first'tape'block := false;                            <<01869>>08660000
         end                                                            08665000
                                                               <<01869>>08670000
      else                                                              08675000
                                                                        08680000
      << we've found the last good block. if the last record >>         08685000
      << was not a trailer record, then the log file was     >>         08690000
      << never properly closed. tell operator that no eof was>>         08695000
      << found in the log file.                              >>         08700000
                                                                        08705000
      if not eoforerr and last'rec'code <> trailer             <<01869>>08710000
         and currrec > 1d then                                 <<01869>>08715000
         begin                                                          08720000
         exchangedb(0);    << back to stack >>                          08725000
         fspace(fileno,-1);                                    <<01869>>08730000
         genmsg(setno,readerr,0,@fname,@procname,,,,0);        <<01869>>08735000
         exchangedb(bufdst);      << to logbuff >>                      08740000
         end;                                                           08745000
      end                                                               08750000
   until eoforerr or not valid;                                         08755000
                                                                        08760000
end;      << subroutine find'last'record >>                             08765000
$page "Logging Process -- Continue'Disc'Logging"               <<01869>>08770000
subroutine continue'disc'logging;                                       08775000
begin                                                                   08780000
                                                               <<01869>>08785000
<< called when want to continue disc logging after a restart >><<01869>>08790000
<< to find the last good record previously written to the log>><<01869>>08795000
<< file. will allocate the next extent, calculate the record >>         08800000
<< offset within the current extent, etc. needed to manage   >>         08805000
<< the disc log file. if any errors are encountered, will    >>         08810000
<< print message to console and go out. db at logbuff.       >>         08815000
<<                                                           >>         08820000
<< entry:                                                    >>         08825000
<<   currrec   - current record number (last good rec + 1).  >>         08830000
<<   numext    - max # extents.                              >>         08835000
<<                                                           >>         08840000
<< exit:                                                     >>         08845000
<<   addr      - disc address of current extent.             >>         08850000
<<   blocknum  - block number of last block in current ext.  >>         08855000
<<   discldev  - ldev of current extent.                     >><<01869>>08860000
<<   dtemp     - # records in current extent.                >>         08865000
<<   extnum    - current extent number.                      >>         08870000
<<   flab      - file label of disc log file.                >>         08875000
<<   logbuff   - globals updated to reflect state of the file>>         08880000
                                                                        08885000
                                                               <<01869>>08890000
                                                                        08895000
                                                                        08900000
      extnum:=integer(((((lastrec-dlogbuff(recs'in'prev))      <<01869>>08905000
       /double(blkfactor)+1d)                                  <<01869>>08910000
       /double(extsize/blkfactor))))+1;                        <<01869>>08915000
                                                               <<01869>>08920000
      << remember when calculating inbufrec (offset into the >><<01869>>08925000
      << current extent for the next writes), to add 1 extra >><<01869>>08930000
      << block (for the flab).                               >><<01869>>08935000
                                                               <<01869>>08940000
      dlogbuff(inbufrec):=((lastrec-dlogbuff(recs'in'prev))    <<01869>>08945000
        +double(extsize+blkfactor))-double(extnum)             <<01869>>08950000
        *double(extsize);                                      <<01869>>08955000
      dlogbuff(fspace') := double(extnum)*double(extsize)      <<01869>>08960000
        -double(blkfactor)-lastrec+dlogbuff(recs'in'prev);     <<01869>>08965000
      if extnum = numext then                                  <<01869>>08970000
         begin                                                 <<01869>>08975000
         << we must reserve the last record of this extent so>><<01869>>08980000
         << the proper close info can be posted to the file. >><<01869>>08985000
                                                               <<01869>>08990000
         dlogbuff(fspace') := dlogbuff(fspace') - 1d;          <<01869>>08995000
         dlogbuff(fsize) := double(flab(lastext)) - 1d;        <<01869>>09000000
         end                                                   <<01869>>09005000
      else dlogbuff(fsize) := double(extsize);                 <<01869>>09010000
                                                               <<01869>>09015000
      dtemp:=(currrec-dlogbuff(recs'in'prev))/                 <<01869>>09020000
        double(blkfactor);                                     <<01869>>09025000
      logbuff(bufused):=integer((currrec-dlogbuff(recs'in'prev))        09030000
        -(dtemp*double(blkfactor)));                           <<01869>>09035000
      logbuff(bspace) := blkfactor - logbuff(bufused);         <<01869>>09040000
                                                               <<01869>>09045000
      << if this is the last block of the last extent, then  >><<01869>>09050000
      << save the last record for proper close information.  >><<01869>>09055000
                                                               <<01869>>09060000
      if extnum = numext and                                   <<01869>>09065000
         dlogbuff(fspace') <= double(blkfactor)                <<01869>>09070000
        then logbuff(bspace) := logbuff(bspace) - 1;           <<01869>>09075000
                                                               <<01869>>09080000
                                                               <<01869>>09085000
      << allocate the extent, and set eof to end of extent. >> <<01869>>09090000
                                                               <<01869>>09095000
      blocknum := double(extnum * integer(extsize/blkfactor))  <<01869>>09100000
                  - 2d;                                                 09105000
      if extnum = numext    << last extent may be different >> <<01869>>09110000
         then blocknum := blocknum + double(flab(lastext)/     <<01869>>09115000
                          blkfactor)-double(extsize/blkfactor);<<01869>>09120000
                                                               <<01869>>09125000
      dlogbuff(trecs):=currrec;                                <<01869>>09130000
      exchangedb(0);   << back to stack >>                              09135000
                                                               <<01869>>09140000
      fwritedir(fileno,buffarea,blksize,blocknum);             <<01869>>09145000
      if <> then                                               <<01869>>09150000
         begin        <<error writing to disc>>                <<01869>>09155000
         if switch'flag then                                   <<01869>>09160000
            abend'(newfwriteerror,fileno,disc,print'fname)     <<01869>>09165000
         else                                                  <<01869>>09170000
            abend'(fwriteerror,fileno,disc,print'fname);       <<01869>>09175000
         end;       <<error writing to disc>>                  <<01869>>09180000
                                                               <<01869>>09185000
      fcontrol(fileno,set'eof,dummy);   << write eof >>        <<01869>>09190000
      if < then         <<failed to write eof>>                <<01869>>09195000
         begin                                                 <<01869>>09200000
         if switch'flag then                                   <<01869>>09205000
            abend'(newfwriteerror,fileno,disc,print'fname)     <<01869>>09210000
         else                                                  <<01869>>09215000
            abend'(fwriteerror,fileno,disc,print'fname);       <<01869>>09220000
         end;                                                  <<01869>>09225000
                                                               <<01869>>09230000
      if flabio(flabldev,flabaddr,read,flab) <> 0 then         <<01869>>09235000
         begin                                                 <<01869>>09240000
         if switch'flag then                                   <<01869>>09245000
            abend'(newfwriteerror,fileno,disc,print'fname)     <<01869>>09250000
         else                                                  <<01869>>09255000
            abend'(fwriteerror,fileno,disc,print'fname);       <<01869>>09260000
         end;                                                  <<01869>>09265000
      exchangedb(bufdst);     << back to logbuff >>                     09270000
      <<get ldev #, and sector # for this extent>>             <<01869>>09275000
      addr:=dflab(21+extnum);                                           09280000
      discldev := lun(addr1.(0:8),fgetpvinfo(fileno).(4:4));   <<01869>>09285000
      logbuff(logdev) := entry'(lgdev) := discldev;            <<01869>>09290000
      addr1.(0:8):=0;    << get rid of ldev # >>                        09295000
      dlogbuff(logaddr) := dentry'(lgaddr) := addr;            <<01869>>09300000
      logbuff(extent):=extnum;                                 <<01869>>09305000
                                                               <<01869>>09310000
end;      << subroutine continue'logging >>                             09315000
$page "Logging Process -- Continue'Serial'Logging"             <<01869>>09320000
subroutine continue'serial'logging;                                     09325000
begin                                                                   09330000
                                                                        09335000
<< called when want to continue serial logging after a       >><<01869>>09340000
<< restart to set up the logbuff to reflect the last good    >><<01869>>09345000
<< record written to the log file.                           >><<01869>>09350000
<<                                                           >>         09355000
<< entry:                                                    >>         09360000
<<   addr    - sector address of disc buffer file.           >>         09365000
<<   currrec - current record (last good rec + 1).           >>         09370000
<<   dtemp   - max # records in the disc buffer file.        >>         09375000
<<                                                           >>         09380000
<< exit:                                                     >>         09385000
<<   logbuff updated and ready to continue logging.          >>         09390000
                                                                        09395000
                                                                        09400000
                                                                        09405000
                                                                        09410000
                                                                        09415000
dlogbuff(inbufrec):=0d;                                                 09420000
dlogbuff(trecs):=currrec;                                               09425000
dlogbuff(logaddr):=addr;                                                09430000
dtemp:=(currrec-dlogbuff(recs'in'prev))/double(blkfactor);     <<01869>>09435000
logbuff(bufused):=integer(currrec-dlogbuff(recs'in'prev)       <<01869>>09440000
  -(dtemp*double(blkfactor)));                                 <<01869>>09445000
logbuff(bspace) := blkfactor - logbuff(bufused);               <<01869>>09450000
                                                                        09455000
   if entry'(lgtype) = sdisc or entry'(lgtype) = ctape then    <<01869>>09460000
    begin                                                      <<01869>>09465000
      << we need to issue a special write request for the   >> <<01869>>09470000
      << first write to a sdisc or ctape log file. this will>> <<01869>>09475000
      << post an eod marker to the gap table of the serial  >> <<01869>>09480000
      << disc interface so that recovery will be possible   >> <<01869>>09485000
      << in the event that the system goes down.            >> <<01869>>09490000
                                                               <<01869>>09495000
      exchangedb(0);                                           <<01869>>09500000
      fwrite(fileno,buffarea,zero'length,special'write);       <<01869>>09505000
      if <> then                                               <<01869>>09510000
      begin                                                    <<01869>>09515000
      if switch'flag then                                      <<01869>>09520000
         abend'(newfwriteerror,fileno,disc,print'fname)        <<01869>>09525000
      else                                                     <<01869>>09530000
         abend'(fwriteerror,fileno,disc,print'fname);          <<01869>>09535000
      end;                                                     <<01869>>09540000
    end;                                                       <<01869>>09545000
end;    << subroutine continue'serial'logging >>                        09550000
$page "Logging Process -- Continue'Logging"                    <<01869>>09555000
subroutine continue'logging;                                            09560000
begin                                                                   09565000
                                                                        09570000
<< called when want to continue logging to a log file that   >>         09575000
<< just been re-opened. will call the appropriate routine to >>         09580000
<< read and verify the current contents of the log file.     >>         09585000
<< db is at logbuff.                                         >>         09590000
                                                                        09595000
if entry'(lgtype) = disc                                       <<01869>>09600000
    then  continue'disc'logging                                         09605000
else continue'serial'logging;                                           09610000
                                                                        09615000
end;    << subroutine continue'logging >>                               09620000
$page "Logging Process -- Allocate'Next'Extent"                <<01869>>09625000
logical subroutine allocate'next'extent;                                09630000
begin                                                                   09635000
                                                                        09640000
<< called when user needs the next extent allocated for disc >>         09645000
<< log file. will allocate the extent, set eof to end of the >>         09650000
<< extent and update the logbuff to reflect the size of this >>         09655000
<< extent.  db at logbuf on entry and exit.                  >>         09660000
<<                                                           >>         09665000
<< returns:                                                  >>         09670000
<<   true - extent allocated and everything o.k.             >>         09675000
<<   false- error - extent not allocated.                    >>         09680000
<<                                                           >>         09685000
<< entry:                                                    >>         09690000
<<   extnum   - current extent number.                       >>         09695000
<<   numext   - maximum number of extents for the log file.  >>         09700000
<<                                                           >>         09705000
<< exit:                                                     >>         09710000
<<   addr     - disc address of the new extent.              >>         09715000
<<   blocknum - block number of last block of new extent.    >>         09720000
<<   discldev - ldev of current extent                       >><<01869>>09725000
<<   errcode  - if error, file system error number.          >>         09730000
<<   extnum   - new extent number.                           >>         09735000
<<   flab     - file label of disc log file.                 >>         09740000
<<   logbuff  - updated with info about this new extent.     >>         09745000
                                                                        09750000
                                                                        09755000
errcode := 0;                                                           09760000
allocate'next'extent := false;                                          09765000
exchangedb(0);       << make sure at stack >>                           09770000
                                                                        09775000
extnum := extnum + 1;                                                   09780000
blocknum := double(extnum*integer(extsize/blkfactor)) - 2d;             09785000
if extnum = numext                                                      09790000
   then blocknum := blocknum + double(flab(lastext)/blkfactor)          09795000
                    - double(extsize/blkfactor);                        09800000
                                                                        09805000
buffarea := "  ";                                                       09810000
move buffarea(1) := buffarea, (blksize-1);                              09815000
                                                                        09820000
<< now move the record ptr to the end of this extent.        >>         09825000
<< file system will clear the entire extent.                 >>         09830000
                                                                        09835000
fwritedir(fileno,buffarea,blksize,blocknum);                            09840000
if <> then                                                              09845000
   begin      << error - may be out of disc space >>                    09850000
   fcheck(fileno,errcode);                                              09855000
   genmsg(fssetno,errcode,,,,,,,0);                                     09860000
   if errcode = out'of'group'space or                                   09865000
      errcode = out'of'account'space  then                     <<01869>>09870000
      begin                                                    <<01869>>09875000
      if switch'flag then                                      <<01869>>09880000
         ulerrcode := newdiscspace                             <<01869>>09885000
      else                                                     <<01869>>09890000
         ulerrcode := outofdiscspace;                          <<01869>>09895000
      end                                                      <<01869>>09900000
   else                                                        <<01869>>09905000
      begin                                                    <<01869>>09910000
      if switch'flag then                                      <<01869>>09915000
         ulerrcode := newfwriteerror                           <<01869>>09920000
      else                                                     <<01869>>09925000
         ulerrcode := fwriteerror;                             <<01869>>09930000
      end;                                                     <<01869>>09935000
                                                               <<01869>>09940000
   genmsg(setno,ulerrcode,0,@fname,@procname,,,,0);            <<01869>>09945000
                                                               <<01869>>09950000
                                                                        09955000
   if switch'flag then                                                  09960000
      begin                                                             09965000
      del;       << get rid of return address >>               <<01869>>09970000
      go changelog'error'recovery;                             <<01869>>09975000
      end;                                                              09980000
                                                                        09985000
   exchangedb(bufdst);                                                  09990000
   logbuff(msg) := stop;                                                09995000
   if errcode = out'of'group'space or                                   10000000
      errcode = out'of'account'space                                    10005000
      then logbuff(logmsg) := discspace                                 10010000
   else logbuff(logmsg) := writeerr;                                    10015000
   return                                                               10020000
   end;                                                                 10025000
                                                                        10030000
<< update the eof ptr in the file system tables. >>                     10035000
                                                                        10040000
fcontrol(fileno,set'eof,dummy);                                <<01869>>10045000
if <> then                                                              10050000
   begin                                                                10055000
   fcheck(fileno,errcode);                                              10060000
   genmsg(fssetno,errcode,,,,,,,0);                                     10065000
   if switch'flag then                                         <<01869>>10070000
      ulerrcode := newfwriteerror                              <<01869>>10075000
   else                                                        <<01869>>10080000
      ulerrcode := fwriteerror;                                <<01869>>10085000
                                                               <<01869>>10090000
   genmsg(setno,ulerrcode,0,@fname,@procname,,,,0);            <<01869>>10095000
                                                                        10100000
   if switch'flag then                                                  10105000
      begin                                                             10110000
      del;    << get rid of return address >>                  <<01869>>10115000
      go changelog'error'recovery;                             <<01869>>10120000
      end;                                                              10125000
                                                                        10130000
   exchangedb(bufdst);                                                  10135000
   logbuff(logmsg) := writeerr;                                         10140000
   return;                                                              10145000
   end;                                                                 10150000
                                                                        10155000
<< now need to find the disc address of this extent.      >>            10160000
                                                                        10165000
                                                                        10170000
<< now get the extent sizes, etc. from the file label.    >>            10175000
                                                                        10180000
if flabio(flabldev,flabaddr,read,flab) <> 0 then               <<01869>>10185000
   begin                                                                10190000
                                                                        10195000
   if switch'flag then                                                  10200000
      begin                                                             10205000
      del;    << get rid of return address >>                  <<01869>>10210000
      ulerrcode := newflaberror;                               <<01869>>10215000
      genmsg(setno,ulerrcode,0,@fname,@procname,,,,0);         <<01869>>10220000
      go changelog'error'recovery;                             <<01869>>10225000
      end;                                                              10230000
                                                                        10235000
   ulerrcode := flabelerr;                                     <<01869>>10240000
   genmsg(setno,ulerrcode,0,@fname,@procname,,,,0);            <<01869>>10245000
   exchangedb(bufdst);                                                  10250000
   logbuff(logmsg) := writeerr;                                         10255000
   return;                                                              10260000
   end;                                                                 10265000
                                                                        10270000
<< now reset the disc address and ldev #. >>                            10275000
                                                                        10280000
addr := dflab(21+extnum);                                               10285000
discldev := lun(addr1.(0:8),fgetpvinfo(fileno).(4:4));         <<01869>>10290000
addr1.(0:8) := 0;    << get rid of ldev >>                     <<01869>>10295000
                                                                        10300000
<< if this is the last extent, need to leave one record free >>         10305000
<< for now so there will be enough room for the trailer      >>         10310000
<< or changelog record.                                      >>         10315000
                                                                        10320000
if extnum = numext                                                      10325000
   then tos := double(flab(lastext)) - 1d                               10330000
else tos := double(flab(fextsize));                                     10335000
                                                                        10340000
exchangedb(bufdst);                                                     10345000
                                                                        10350000
<< now update the global info in the logbuff. >>                        10355000
                                                                        10360000
dlogbuff(fspace') := dlogbuff(fsize) := tos;                            10365000
logbuff(extent) := extnum;                                              10370000
logbuff(logdev) := discldev;                                   <<01869>>10375000
dlogbuff(logaddr) := addr;                                              10380000
dlogbuff(inbufrec) := 0d;                                               10385000
logbuff(logmsg) := continue;                                            10390000
                                                                        10395000
allocate'next'extent := true;                                           10400000
                                                                        10405000
end;   << subroutine allocate'next'extent >>                            10410000
$page "Logging Process -- Empty'Disc'Buffer"                   <<01869>>10415000
logical subroutine empty'disc'buffer(length);                           10420000
   value length;                                                        10425000
   integer length;                                                      10430000
begin                                                                   10435000
                                                                        10440000
<< called when need to move stuff from the disc buffer file to >>       10445000
<< the serial log file. db at logbuff on entry and exit.       >>       10450000
<<                                                             >>       10455000
<< entry:                                                      >>       10460000
<<   length    - # words to xfer from disc to serial log file. >>       10465000
<<   outbufrec - block # to start the read from disc.          >>       10470000
<<                                                             >>       10475000
<< exit:                                                       >>       10480000
<<   errcode   - if error, file system error number.           >>       10485000
<<   ulerrcode - if error, user logging error number.          <<01869>>10490000
                                                                        10495000
                                                                        10500000
errcode := 0;                                                           10505000
                                                                        10510000
empty'disc'buffer := false;                                             10515000
exchangedb(0);                                                          10520000
                                                                        10525000
freaddir(buffileno,buffarea,length,outbufrec);                          10530000
if <> then                                                              10535000
   begin                                                                10540000
   freaddir(buffileno,buffarea,length,outbufrec);                       10545000
   if <> then                                                           10550000
      begin                                                             10555000
      fcheck(buffileno,errcode);                                        10560000
      genmsg(fssetno,errcode,,,,,,,0);                                  10565000
                                                                        10570000
      if switch'flag then                                               10575000
         begin                                                          10580000
         del;    << get rid of return address >>               <<01869>>10585000
         ulerrcode := newbwriteerror;                          <<01869>>10590000
         genmsg(setno,ulerrcode,0,@bfname,@procname,,,,0);     <<01869>>10595000
         go changelog'error'recovery;                          <<01869>>10600000
         end;                                                           10605000
                                                                        10610000
      ulerrcode := bwriteerror;                                <<01869>>10615000
      genmsg(setno,ulerrcode,0,@bfname,@procname,,,,0);        <<01869>>10620000
      exchangedb(bufdst);                                               10625000
      return;                                                           10630000
      end;                                                              10635000
   end;                                                                 10640000
                                                                        10645000
fwrite(fileno,buffarea,length,normal'write);                            10650000
if <> then                                                              10655000
   begin                                                                10660000
   fcheck(fileno,errcode);                                              10665000
   if errcode = syspowerfail or errcode = tapepowerfail then            10670000
      begin                                                             10675000
      if tape' then                                                     10680000
         begin                                                          10685000
         if recpfail(fileno,dbuffarea,tapedev,first'tape'block)<<01869>>10690000
            then go okay;                                      <<01869>>10695000
         genmsg(setno,pfailerror,0,@fname,@procname,,,,0);     <<01869>>10700000
         end;                                                           10705000
      end                                                               10710000
   else                                                        <<01869>>10715000
      begin                                                    <<01869>>10720000
      if switch'flag then                                      <<01869>>10725000
         ulerrcode := newfwriteerror                           <<01869>>10730000
      else ulerrcode := fwriteerror;                           <<01869>>10735000
      genmsg(setno,ulerrcode,0,@fname,@procname,,,,0);         <<01869>>10740000
      end;                                                     <<01869>>10745000
                                                                        10750000
                                                                        10755000
   if switch'flag then                                                  10760000
      begin                                                             10765000
      del;     << get rid of return address >>                 <<01869>>10770000
      go changelog'error'recovery;                             <<01869>>10775000
      end;                                                              10780000
                                                                        10785000
   exchangedb(bufdst);                                                  10790000
   logbuff(logmsg) := writeerr;                                         10795000
   logbuff(msg) := suspend;                                             10800000
   return;                                                              10805000
   end;                                                                 10810000
                                                                        10815000
okay:                                                                   10820000
                                                                        10825000
first'tape'block := false;                                     <<01869>>10830000
exchangedb(bufdst);                                                     10835000
empty'disc'buffer := true;                                              10840000
                                                                        10845000
end;   << subroutine empty'disc'buffer >>                               10850000
$page "Logging Process -- Set'Up'Logbuff"                      <<01869>>10855000
subroutine set'up'logbuff;                                     <<01869>>10860000
   begin                                                       <<01869>>10865000
                                                               <<01869>>10870000
   << called during a changelog to update the global info in >><<01869>>10875000
   << the logbuff to reflect the new characteristics of the  >><<01869>>10880000
   << log file.                                              >><<01869>>10885000
                                                               <<01869>>10890000
   logbuff(logmsg):=continue;                                  <<01869>>10895000
   logbuff(logtype):=q'newtype;                                <<01869>>10900000
   logbuff(vsetno):=q'vsetno;                                  <<01869>>10905000
   logbuff(usermsg):=continue;                                 <<01869>>10910000
   logbuff(logerr):=0;                                         <<01869>>10915000
   dlogbuff(recs'in'prev):=dlogbuff(trecs);                    <<01869>>10920000
   logbuff(bspace):=blkfactor;                                          10925000
   logbuff(bufused):=0;                                                 10930000
   logbuff(extent) := extnum;                                  <<01869>>10935000
   dlogbuff(fspace') := dentry'(bsize) := dtemp;               <<01869>>10940000
   dlogbuff(maxfspace) := limit - 1d;                          <<01869>>10945000
   dlogbuff(logaddr) := dentry'(lgaddr) := addr;               <<01869>>10950000
   logbuff(vsetno) := q'vsetno;                                <<01869>>10955000
   dlogbuff(fsize) := dtemp;                                   <<01869>>10960000
   dlogbuff(inbufrec) := 0d;                                   <<01869>>10965000
   logbuff(logtype)  := logbuff(newtype);                      <<01869>>10970000
   entry'(lgtype) := logbuff(newtype);                         <<01869>>10975000
   logbuff(logdev) := entry'(lgdev) := discldev;               <<01869>>10980000
      if q'newtype <> disc then dlogbuff(inbufrec):=0d;        <<01869>>10985000
      logbuff(logerr):=0;                                      <<01869>>10990000
      logbuff(usermsg):=continue;                              <<01869>>10995000
      logbuff(bufused):=0;                                     <<01869>>11000000
      free'last'extent:=false;                                          11005000
   logbuff(lastext') := numext;                                <<01869>>11010000
   if logbuff(logtype) <> disc then                            <<01869>>11015000
      begin                                                    <<01869>>11020000
      dlogbuff(old'limit) := 0d;                               <<01869>>11025000
      logbuff(old'numext) := 0;                                <<01869>>11030000
      end;                                                     <<01869>>11035000
                                                               <<01869>>11040000
   outbufrec := 0d;                                            <<01869>>11045000
   end;      << subroutine set'up'logbuff >>                   <<01869>>11050000
$page "Logging Process -- Get'New'File"                        <<01869>>11055000
subroutine get'new'file;                                       <<01869>>11060000
   begin                                                       <<01869>>11065000
                                                               <<01869>>11070000
   << obtains the new file name for the next log file in the >><<01869>>11075000
   << set. if the old and new file is serial, then closes the>><<01869>>11080000
   << old log file so that is can open the new serial file on>><<01869>>11085000
   << the same device if wanted.                             >><<01869>>11090000
   <<                                                        >><<01869>>11095000
   <<                                                        >><<01869>>11100000
   <<                                                        >><<01869>>11105000
   <<                                                        >><<01869>>11110000
   <<                                                        >><<01869>>11115000
                                                               <<01869>>11120000
   q'old'limit := dlogbuff(maxfspace) + 1d;                    <<01869>>11125000
   q'old'numext := logbuff(numext);                            <<01869>>11130000
   q'vsetno:=logbuff(vsetno);                                  <<01869>>11135000
   q'newtype:=logbuff(newtype);                                <<01869>>11140000
   q'oldtype:=logbuff(logtype);                                <<01869>>11145000
   exchangedb(0);                                              <<01869>>11150000
                                                               <<01869>>11155000
   << make sure get latest copy of logtab entry >>             <<01869>>11160000
                                                               <<01869>>11165000
   move'from'dseg(@entry',logdst,tabindex',tentrysize);        <<01869>>11170000
                                                               <<01869>>11175000
   entry'(lgtype):=q'newtype;                                  <<01869>>11180000
   move temp'file'name':= " ";                                 <<01869>>11185000
   move temp'file'name'(1):=temp'file'name',(7);               <<01869>>11190000
   move temp'file'name' := bentry'(lfname),(8);                <<01869>>11195000
   temp'file'name'(8) := 0;                                    <<01869>>11200000
   move temp'file'name' := temp'file'name' while ans,1;        <<01869>>11205000
   file'name'len:=tos-@temp'file'name';                        <<01869>>11210000
   if (q'vsetno:=q'vsetno+1) > 999 then                        <<01869>>11215000
      q'vsetno:=1;                                             <<01869>>11220000
                                                               <<01869>>11225000
   << get old file name from the lidtab. do this to make sure>><<01869>>11230000
   << get the lockword if it had one. (the lockwords get     >><<01869>>11235000
   << deleted so that they will not appear in any messages.  >><<01869>>11240000
                                                               <<01869>>11245000
   fentry'switch(bentry'(lgname),,old'file'name,,,lid'typ);    <<01869>>11250000
                                                               <<01869>>11255000
   move fname := old'file'name, (36);                          <<01869>>11260000
   fname(36) := 0;                                             <<01869>>11265000
   if q'vsetno = 1 then                                        <<01869>>11270000
      move fname(file'name'len-3):="000";                      <<01869>>11275000
   ascii(q'vsetno,-10,fname(file'name'len-1));                 <<01869>>11280000
   move'to'dseg(bufdst,next'file/2,@fname/2,18);               <<01869>>11285000
                                                               <<01869>>11290000
   deposit'filename(fname,bentry'(lfname),bentry'(lflockw),    <<01869>>11295000
                    bentry'(lfgroup),bentry'(lfacct));         <<01869>>11300000
                                                               <<01869>>11305000
   << make sure logdst is updated on disc for warmstart      >><<01869>>11310000
   << recovery.                                              >><<01869>>11315000
                                                               <<01869>>11320000
   move'to'dseg(logdst,tabindex',@entry',tentrysize-2);        <<01869>>11325000
   writedseg(logdst);                                          <<01869>>11330000
                                                               <<01869>>11335000
   exchangedb(bufdst);                                         <<01869>>11340000
   logbuff(n'type):=q'newtype;                                 <<01869>>11345000
   format'next'file;                                           <<01869>>11350000
   flush(null,false);     << tell it we are the log process >> <<01869>>11355000
   checkmsg;                                                   <<01869>>11360000
                                                               <<01869>>11365000
   exchangedb(0);                                              <<01869>>11370000
   errcode:=0;                                                 <<01869>>11375000
   savefileno:=fileno;                                         <<01869>>11380000
                                                               <<01869>>11385000
   if q'newtype = disc then                                    <<01869>>11390000
      begin                                                    <<01869>>11395000
      if q'oldtype <> disc then                                <<01869>>11400000
         begin                                                 <<01869>>11405000
         << old log file was serial, new log file is disc >>   <<01869>>11410000
         << therefore, must close (and purge) the disc buffer>><<01869>>11415000
         << file. but first make sure it gets posted to the  >><<01869>>11420000
         << serial log file.                                 >><<01869>>11425000
                                                               <<01869>>11430000
         exchangedb(bufdst);                                   <<01869>>11435000
         count:=integer(dlogbuff(fsize)-dlogbuff(fspace'))*recsize;     11440000
         do                                                    <<01869>>11445000
            begin                                              <<01869>>11450000
            << may require more that 1 write to empty buffer >><<01869>>11455000
                                                               <<01869>>11460000
            if count > blksize then                            <<01869>>11465000
               begin                                           <<01869>>11470000
               tempcnt:=count-blksize;                         <<01869>>11475000
               count:=blksize;                                 <<01869>>11480000
               end                                             <<01869>>11485000
            else tempcnt:=0;                                   <<01869>>11490000
            if not empty'disc'buffer(count) then               <<01869>>11495000
               begin                                           <<01869>>11500000
               exchangedb(0);                                  <<01869>>11505000
               ulerrcode := bwriteerror;                       <<01869>>11510000
              genmsg(setno,ulerrcode,0,@bfname,@procname,,,,0);<<01869>>11515000
               del;    << get rid of return address >>         <<01869>>11520000
               go changelog'error'recovery;                    <<01869>>11525000
               end;                                            <<01869>>11530000
                                                               <<01869>>11535000
            count:=tempcnt;  <<words left>>                    <<01869>>11540000
            outbufrec:=outbufrec+double(blkfactor);            <<01869>>11545000
            if outbufrec >= dlogbuff(fsize) then               <<01869>>11550000
            outbufrec:=0d;                                     <<01869>>11555000
            dlogbuff(fspace'):=dlogbuff(fspace') +             <<01869>>11560000
                               double(count/recsize);          <<01869>>11565000
            end                                                <<01869>>11570000
         until count <= 0;                                     <<01869>>11575000
         exchangedb(0);                                        <<01869>>11580000
         end;                                                  <<01869>>11585000
                                                               <<01869>>11590000
      << o.k. disc buffer file now posted to tape. there is >> <<01869>>11595000
      << a possiblity of having more info in the buffer file>> <<01869>>11600000
      << if it is less than one block. will need to force   >> <<01869>>11605000
      open'disc'logfile;                                       <<01869>>11610000
      if errcode <> 0 then                                     <<01869>>11615000
         begin                                                 <<01869>>11620000
         fileno:=savefileno;                                   <<01869>>11625000
         del;     << get rid of return address >>              <<01869>>11630000
         go changelog'error'recovery;                          <<01869>>11635000
         end;   << error opening new disc log file >>          <<01869>>11640000
      end <<newtype=disc>>                                     <<01869>>11645000
   else                                                        <<01869>>11650000
      begin                                                    <<01869>>11655000
      <<newtype=serial>>                                       <<01869>>11660000
      if q'oldtype <> disc then                                <<01869>>11665000
         begin                                                 <<01869>>11670000
         << for this case, we can use the "old" buffer file  >><<01869>>11675000
         << for the new serial log file.                     >><<01869>>11680000
                                                               <<01869>>11685000
         <<must close old file>>                               <<01869>>11690000
         exchangedb(bufdst);                                   <<01869>>11695000
         count:=integer(dlogbuff(fsize)-dlogbuff(fspace'))*recsize;     11700000
                                                               <<01869>>11705000
         << still must flush out the disc buffer file to the>> <<01869>>11710000
         << "old" serial log file.                          >> <<01869>>11715000
                                                               <<01869>>11720000
         do                                                    <<01869>>11725000
            begin                                              <<01869>>11730000
            << may require more than 1 write to empty buffer>> <<01869>>11735000
                                                               <<01869>>11740000
            if count > blksize then                            <<01869>>11745000
               begin                                           <<01869>>11750000
               tempcnt:=count-blksize;                         <<01869>>11755000
               count:=blksize;                                 <<01869>>11760000
               end                                             <<01869>>11765000
            else tempcnt:=0;                                   <<01869>>11770000
            if not empty'disc'buffer(count) then               <<01869>>11775000
               begin                                           <<01869>>11780000
               exchangedb(0);                                  <<01869>>11785000
               ulerrcode := bwriteerror;                       <<01869>>11790000
              genmsg(setno,ulerrcode,0,@bfname,@procname,,,,0);<<01869>>11795000
               del;     << get rid of return address >>        <<01869>>11800000
               go changelog'error'recovery;                    <<01869>>11805000
               end;                                            <<01869>>11810000
                                                               <<01869>>11815000
            outbufrec:=outbufrec+double(blkfactor);            <<01869>>11820000
            if outbufrec >= dlogbuff(fsize) then               <<01869>>11825000
            outbufrec:=0d;                                     <<01869>>11830000
            dlogbuff(fspace'):=dlogbuff(fspace') +             <<01869>>11835000
                               double(count/recsize);          <<01869>>11840000
            count:=tempcnt;  <<words left>>                    <<01869>>11845000
            end                                                <<01869>>11850000
         until count <= 0;                                     <<01869>>11855000
         exchangedb(0);                                        <<01869>>11860000
         fclose(fileno,0,0);                                   <<01869>>11865000
         if <> then                                            <<01869>>11870000
            begin                                              <<01869>>11875000
            << error closing "old" serial log file >>          <<01869>>11880000
                                                               <<01869>>11885000
            fcheck(fileno,errcode);                            <<01869>>11890000
             genmsg(fssetno,errcode,,,,,,,0);                  <<01869>>11895000
            ulerrcode := bwriteerror;                          <<01869>>11900000
            genmsg(setno,ulerrcode,0,@bfname,@procname,,,,0);  <<01869>>11905000
            del;      << get rid of return address >>          <<01869>>11910000
            go changelog'error'recovery;                       <<01869>>11915000
            end;                                               <<01869>>11920000
         end;                                                  <<01869>>11925000
                                                               <<01869>>11930000
      << will try to open the new serial log file. in case>>   <<01869>>11935000
      << of error, will only attempt the open 3 times.    >>   <<01869>>11940000
                                                               <<01869>>11945000
      i:=0;                                                    <<01869>>11950000
      do                                                       <<01869>>11955000
         begin                                                 <<01869>>11960000
         errcode:=0;                                           <<01869>>11965000
         open'serial'logfile;                                  <<01869>>11970000
         end until (i:=i+1) >= 3 or (errcode = 0);             <<01869>>11975000
                                                               <<01869>>11980000
      if errcode <> 0 then                                     <<01869>>11985000
         begin                                                 <<01869>>11990000
         del;     << get rid of return address >>              <<01869>>11995000
         go changelog'error'recovery;                          <<01869>>12000000
         end;                                                  <<01869>>12005000
      end;<<newtype=serial>>                                   <<01869>>12010000
                                                               <<01869>>12015000
   end;            << subroutine get'new'file >>               <<01869>>12020000
$page "Logging Process -- Finish'Changelog"                    <<01869>>12025000
subroutine finish'changelog;                                   <<01869>>12030000
   begin                                                       <<01869>>12035000
   << completes the changelog. if the "old" log file is disc,>><<01869>>12040000
   << will close it. if the "old" log file is tape and the   >><<01869>>12045000
   << new is disc, closes the old tape and disc buffer file. >><<01869>>12050000
   << also, formats current and previous file entries in the >><<01869>>12055000
   << comm. area of the logbuff.                             >><<01869>>12060000
                                                               <<01869>>12065000
   if q'newtype = disc then                                    <<01869>>12070000
      begin                                                    <<01869>>12075000
      exchangedb(bufdst);                                      <<01869>>12080000
      flush(null,false);   << tell it we are the log process >><<01869>>12085000
      checkmsg;                                                <<01869>>12090000
                                                               <<01869>>12095000
      if q'oldtype<>disc then                                  <<01869>>12100000
         begin                                                 <<01869>>12105000
         <<must make log process post to tape>>                <<01869>>12110000
                                                               <<01869>>12115000
         << may want to make sure the disc buffer file gets  >><<01869>>12120000
         << posted to tape before close and purge it.        >><<01869>>12125000
                                                               <<01869>>12130000
         exchangedb(0);                                        <<01869>>12135000
         fclose(buffileno,0,0);                                <<01869>>12140000
         if <> then                                            <<01869>>12145000
            begin                                              <<01869>>12150000
            fcheck(buffileno,errcode);                         <<01869>>12155000
            genmsg(fssetno,errcode,,,,,,,0);                   <<01869>>12160000
            ulerrcode := oldbclosefail;                        <<01869>>12165000
            genmsg(setno,ulerrcode,0,@bfname,@procname,,,,0);  <<01869>>12170000
            del;     << get rid of return address >>           <<01869>>12175000
            go changelog'error'recovery;                       <<01869>>12180000
            end;                                               <<01869>>12185000
         fclose(savefileno,0,0);                               <<01869>>12190000
         if <> then                                            <<01869>>12195000
            begin                                              <<01869>>12200000
            fcheck(savefileno,errcode);                        <<01869>>12205000
            genmsg(fssetno,errcode,,,,,,,0);                   <<01869>>12210000
            ulerrcode := oldlogclosefail;                      <<01869>>12215000
            genmsg(setno,ulerrcode,0,@old'file'name,@procname, <<01869>>12220000
                   ,,,0);                                      <<01869>>12225000
            del;     << get rid of return address >>           <<01869>>12230000
            go changelog'error'recovery;                       <<01869>>12235000
            end;                                               <<01869>>12240000
         end      << old type was serial >>                    <<01869>>12245000
      else                                                     <<01869>>12250000
         begin                                                 <<01869>>12255000
         << old log type was disc >>                           <<01869>>12260000
                                                               <<01869>>12265000
         fpoint(savefileno,(dlogbuff(trecs)-dlogbuff(recs'in'prev))     12270000
                /double(blkfactor));                           <<01869>>12275000
         exchangedb(0);                                        <<01869>>12280000
         fcontrol(savefileno,set'eof,dummy);                   <<01869>>12285000
         if <> then                                            <<01869>>12290000
            begin                                              <<01869>>12295000
            fcheck(savefileno,errcode);                        <<01869>>12300000
            genmsg(fssetno,errcode,,,,,,,0);                   <<01869>>12305000
            ulerrcode := fwriteerror;                          <<01869>>12310000
            genmsg(setno,ulerrcode,0,@old'file'name,@procname, <<01869>>12315000
                   ,,,0);                                      <<01869>>12320000
            del;     << get rid of return address >>           <<01869>>12325000
            go changelog'error'recovery;                       <<01869>>12330000
            end;                                               <<01869>>12335000
         fclose(savefileno,0,0);                               <<01869>>12340000
         if <> then                                            <<01869>>12345000
            begin                                              <<01869>>12350000
            fcheck(savefileno,errcode);                        <<01869>>12355000
            genmsg(fssetno,errcode,,,,,,,0);                   <<01869>>12360000
            ulerrcode := oldlogclosefail;                      <<01869>>12365000
            genmsg(setno,ulerrcode,0,@old'file'name,@procname, <<01869>>12370000
                   ,,,0);                                      <<01869>>12375000
            del;    << get rid of return address >>            <<01869>>12380000
            go changelog'error'recovery;                       <<01869>>12385000
            end;                                               <<01869>>12390000
         end;                                                  <<01869>>12395000
      end <<newtype=disc>>                                     <<01869>>12400000
   else                                                        <<01869>>12405000
      begin                                                    <<01869>>12410000
      <<new file is serial>>                                   <<01869>>12415000
      if q'oldtype=disc then                                   <<01869>>12420000
         begin                                                 <<01869>>12425000
         <<must open new buffer>>                              <<01869>>12430000
         exchangedb(0);                                        <<01869>>12435000
         open'buffer'file;                                     <<01869>>12440000
         if errcode<>0 then                                    <<01869>>12445000
            begin                                              <<01869>>12450000
            del;   << get rid of return address >>             <<01869>>12455000
            go changelog'error'recovery;                       <<01869>>12460000
            end;                                               <<01869>>12465000
         <<close old file>>                                    <<01869>>12470000
         exchangedb(bufdst);                                   <<01869>>12475000
         fpoint(savefileno,(dlogbuff(trecs)-dlogbuff(recs'in'prev))     12480000
                /double(blkfactor) - 1d);                      <<01869>>12485000
         if <> then                                            <<01869>>12490000
            begin                                              <<01869>>12495000
            exchangedb(0);                                     <<01869>>12500000
            <<error closing log file>>                         <<01869>>12505000
            fcheck(fileno,errcode);                            <<01869>>12510000
            genmsg(fssetno,errcode,,,,,,,0);                   <<01869>>12515000
            ulerrcode := fwriteerror;                          <<01869>>12520000
            genmsg(setno,ulerrcode,0,@old'file'name,@procname, <<01869>>12525000
                   ,,,0);                                      <<01869>>12530000
            del;    << get rid of return address >>            <<01869>>12535000
            go changelog'error'recovery;                       <<01869>>12540000
            end;                                               <<01869>>12545000
         exchangedb(0);                                        <<01869>>12550000
         fcontrol(savefileno,set'eof,dummy);                   <<01869>>12555000
         if <> then                                            <<01869>>12560000
            begin                                              <<01869>>12565000
            fcheck(savefileno,errcode);                        <<01869>>12570000
            genmsg(fssetno,errcode,,,,,,,0);                   <<01869>>12575000
            ulerrcode := fwriteerror;                          <<01869>>12580000
            genmsg(setno,ulerrcode,0,@old'file'name,@procname, <<01869>>12585000
                   ,,,0);                                      <<01869>>12590000
            del;    << get rid of return address >>            <<01869>>12595000
            go changelog'error'recovery;                       <<01869>>12600000
            end;                                               <<01869>>12605000
         fclose(savefileno,0,0);                               <<01869>>12610000
         if <> then                                            <<01869>>12615000
            begin                                              <<01869>>12620000
            fcheck(savefileno,errcode);                        <<01869>>12625000
            genmsg(fssetno,errcode,,,,,,,0);                   <<01869>>12630000
            ulerrcode := oldlogclosefail;                      <<01869>>12635000
            genmsg(setno,ulerrcode,0,@old'file'name,@procname, <<01869>>12640000
                   ,,,0);                                      <<01869>>12645000
            del;     << get rid of return address >>           <<01869>>12650000
            go changelog'error'recovery;                       <<01869>>12655000
            end;                                               <<01869>>12660000
         end;  <<oldtype=disc>>                                <<01869>>12665000
      end;<<newfile is serial>>                                <<01869>>12670000
      exchangedb(0);                                           <<01869>>12675000
      move'to'dseg(bufdst,previous'file/2,@old'file'name/2,18);<<01869>>12680000
      move'to'dseg(bufdst,current'file/2,@fname/2,18);         <<01869>>12685000
      exchangedb(bufdst);                                      <<01869>>12690000
      logbuff(p'type):=logbuff(logtype);                       <<01869>>12695000
      logbuff(c'type):=logbuff(newtype);                       <<01869>>12700000
      <<#recs in disc buffer file remains same.we reuse>>      <<01869>>12705000
      <<the old disc buffer file                       >>      <<01869>>12710000
      if q'oldtype <> disc and                                 <<01869>>12715000
         q'newtype <> disc then                                <<01869>>12720000
         dtemp := limit;                                       <<01869>>12725000
   end;                                                        <<01869>>12730000
$page "Logging Process -- Main Body"                           <<01869>>12735000
if (restart' := false) then                                             12740000
   begin                                                                12745000
restart:                                                                12750000
   restart':=true;                                                      12755000
   end;                                                                 12760000
                                                               <<01869>>12765000
                                                               <<01869>>12770000
<< turn traps off  >>                                          <<01869>>12775000
                                                               <<01869>>12780000
assemble(pshr %10);                                                     12785000
tos.(2:1):=0;                                                           12790000
assemble(setr %10);                                                     12795000
                                                               <<01869>>12800000
switch'flag := false;                                          <<01869>>12805000
got'logbuff := false;                                          <<01869>>12810000
                                                                        12815000
<< when return from open'logfile will have the logsir.  >>              12820000
                                                                        12825000
open'logfile;                                             <<04962>>     12830000
                                                                        12835000
<<create logging data segment>>                                         12840000
                                                                        12845000
move'from'dseg(@maxusers,logdst,max'usr'proc,1);               <<01869>>12850000
<< if max users is zero, then can't let anyone start the proc>><<01869>>12855000
                                                               <<01869>>12860000
if maxusers <= 0 then                                          <<01869>>12865000
   abend(bad'user'count,entry'(lgtype),print'procname);        <<01869>>12870000
                                                               <<01869>>12875000
len:=blksize+maxusers*bentrysize+bentrybase;                            12880000
entry'(dst):=bufdst:=getdataseg(len,len);                               12885000
if entry'(dst) = 0                                             <<01869>>12890000
      then abend(nodseg,entry'(lgtype),print'procname);        <<01869>>12895000
                                                                        12900000
got'logbuff := true;                                           <<01869>>12905000
entry'(pin) := mypin;       << pin number of logging process >><<01869>>12910000
                                                                        12915000
<<now write entry back to master logging data segment>>                 12920000
                                                                        12925000
move'to'dseg(logdst,tabindex',@entry',tentrysize-2);           <<01869>>12930000
                                                                        12935000
<<initialize logging data segment>>                                     12940000
                                                                        12945000
<<set up global and communications area>>                               12950000
                                                               <<01869>>12955000
exchangedb(bufdst);   << db to logbuff >>                               12960000
                                                               <<01869>>12965000
<< clear global communications area of logbuff. >>                      12970000
                                                                        12975000
logbuff := 0;                                                  <<01869>>12980000
move logbuff(1):=logbuff, (bentrybase-1);                      <<01869>>12985000
                                                               <<01869>>12990000
<< first get the logid >>                                      <<01869>>12995000
                                                               <<01869>>13000000
tos := bufdst;        << dst of logbuff >>                     <<01869>>13005000
tos := logid/2;       << word offset into logbuff >>           <<01869>>13010000
tos := logdst;        << source dst - logtab >>                <<01869>>13015000
tos := lgname/2 + tabindex';    << word offset in logtab >>    <<01869>>13020000
tos := 4;             << count >>                              <<01869>>13025000
assemble (mds 5);                                              <<01869>>13030000
                                                               <<01869>>13035000
                                                               <<01869>>13040000
dlogbuff(resource):=0d;                                                 13045000
dlogbuff(inbufrec):=0d;                                                 13050000
dlogbuff(logaddr):=addr;                                                13055000
logbuff(auto) := entry'(lgauto);                               <<01869>>13060000
logbuff(change) := allow'changelog;                            <<01869>>13065000
logbuff(logtype) := entry'(lgtype);                            <<01869>>13070000
                                                               <<01869>>13075000
logbuff(newtype) := null;                                      <<01869>>13080000
logbuff(switch') := entry'(lgswitch);                          <<01869>>13085000
logbuff(state) := initializing;                                <<01869>>13090000
logbuff(numuser):=0;                                                    13095000
logbuff(logdev) := entry'(lgdev) := discldev;                  <<01869>>13100000
dlogbuff(fsize):=dtemp;                                        <<01869>>13105000
dlogbuff(maxfspace) := limit - 1d;                             <<01869>>13110000
dlogbuff(fspace'):=dentry'(bsize):=dtemp;                      <<01869>>13115000
logbuff(bspace):=blkfactor;                                             13120000
logbuff(slpct):=0;                                                      13125000
logbuff(userno):=0;                                                     13130000
logbuff(logpin) := entry'(pin) := mypin;                       <<01869>>13135000
dlogbuff(trecs):=0d;                                                    13140000
logbuff(uhead):=null;                                                   13145000
logbuff(fhead):=bentrybase;                                             13150000
logbuff(logerr) := false;                                      <<01869>>13155000
logbuff(fserr'code) := 0;                                      <<01869>>13160000
logbuff(ulerr'code) := 0;                                      <<01869>>13165000
logbuff(head'change'pin) := 0;                                 <<01869>>13170000
logbuff(msg) := continue;                                      <<01869>>13175000
logbuff(usermsg):=continue;                                    <<01869>>13180000
logbuff(logmsg):=continue;                                     <<01869>>13185000
logbuff(maxuser') := maxusers;                                 <<01869>>13190000
logbuff(lastext'):=numext;                                     <<01869>>13195000
logbuff(bdst):=entry'(dst);                                    <<01869>>13200000
outbufrec:=0d;                                                          13205000
logbuff(extent) := extnum;                                     <<01869>>13210000
logbuff(bufused) := 0;                                         <<01869>>13215000
logbuff(vsetno) := q'vsetno;                                   <<01869>>13220000
if entry'(lgtype) <> disc then                                 <<01869>>13225000
   begin                                                       <<01869>>13230000
   dlogbuff(old'limit):=0d;                                    <<01869>>13235000
   logbuff(old'numext):=0;                                     <<01869>>13240000
   end                                                         <<01869>>13245000
else                                                           <<01869>>13250000
   begin                                                       <<01869>>13255000
   logbuff(old'numext):=numext;                                <<01869>>13260000
   dlogbuff(old'limit) := limit;                               <<01869>>13265000
   end;                                                        <<01869>>13270000
                                                                        13275000
<< now set up the user entries of the logbuff >>                        13280000
                                                               <<01869>>13285000
logbuff(bentrybase) := "  ";                                   <<01869>>13290000
move logbuff(bentrybase+1) := logbuff(bentrybase),             <<01869>>13295000
                              (maxusers*bentrysize-1);         <<01869>>13300000
                                                               <<01869>>13305000
temp:=null;                                                             13310000
                                                                        13315000
i:=0;                                                                   13320000
do                                                                      13325000
begin                                                                   13330000
   index:=bentrybase+i*bentrysize;                                      13335000
   logbuff(pentry):=temp;                                               13340000
   logbuff(nentry):=index+bentrysize;                                   13345000
   temp:=index;                                                         13350000
end until (i:=i+1) = maxusers;                                          13355000
                                                               <<01869>>13360000
logbuff(nentry):=null;                                                  13365000
index:=0;                                                               13370000
obtain(dlogbuff(resource),null);                                        13375000
resflag:=true;                                                 <<01869>>13380000
                                                                        13385000
relsir(logsir,a);                                                       13390000
@buf:=bufbase;                                                          13395000
                                                               <<01869>>13400000
<< clear the buffer area of the logbuff. >>                    <<01869>>13405000
                                                               <<01869>>13410000
buf := "  ";                                                   <<01869>>13415000
move buf(1):=buf,(blksize-1);                                           13420000
                                                               <<01869>>13425000
<< now set up pointer to area to format the header record >>   <<01869>>13430000
                                                               <<01869>>13435000
@buf:=bufbase+(blkfactor-logbuff(bspace))*recsize;             <<01869>>13440000
@dbuf:=@buf;                                                            13445000
@bbuf := 2 * @buf;                                             <<01869>>13450000
                                                               <<01869>>13455000
if not restart' then                                                    13460000
begin                                                                   13465000
   << format a log start (header) record.          >>          <<01869>>13470000
                                                               <<01869>>13475000
   dlogbuff(first'c'time) := clock;                            <<01869>>13480000
   logbuff(first'c'date) := calendar;                          <<01869>>13485000
   logbuff(f'type) := entry'(lgtype);                          <<01869>>13490000
   logbuff(c'type) := entry'(lgtype);                          <<01869>>13495000
   logbuff(vsetno) := q'vsetno := 1;                           <<01869>>13500000
   buf(code):=header;                                                   13505000
   dbuf(rnum):=dlogbuff(trecs):=dlogbuff(trecs)+1d;                     13510000
   buf(date):=calendar;                                                 13515000
   dbuf(time):=clock;                                                   13520000
   move bbuf(lid') := blogbuff(logid), (8);                    <<01869>>13525000
                                                               <<01869>>13530000
   x:=recsizem1;                                               <<01869>>13535000
   tos:=-1;                                                             13540000
   do                                                                   13545000
   begin                                                                13550000
      if x <> cksum then                                                13555000
      tos:=tos xor buf(x);                                              13560000
   end until (x:=x-1) < 0;                                              13565000
   buf(cksum):=tos;                                                     13570000
   logbuff(bspace):=logbuff(bspace)-1;                                  13575000
   logbuff(bufused) := logbuff(bufused) + 1;                   <<01869>>13580000
   flush(null,false);                                          <<01869>>13585000
   checkmsg;                                                   <<01869>>13590000
end;                                                                    13595000
                                                               <<01869>>13600000
if restart' then                                                        13605000
begin                                                                   13610000
   << re-read file to see where we left off, format a log    >><<01869>>13615000
   << restart record, and then we're ready to go again.      >><<01869>>13620000
                                                               <<01869>>13625000
   find'last'record;                                                    13630000
                                                               <<01869>>13635000
<< set up logbuff to continue logging >>                       <<01869>>13640000
                                                               <<01869>>13645000
continue'logging;                                              <<01869>>13650000
                                                               <<01869>>13655000
   formatrestart;                                                       13660000
                                                                        13665000
end;                                            <<if restart>>          13670000
                                                                        13675000
logbuff(c'type):=entry'(lgtype);                               <<01869>>13680000
exchangedb(0);         << back to stack >>                              13685000
                                                               <<01869>>13690000
   move'to'dseg(bufdst,current'file/2,@fname/2,18);            <<01869>>13695000
   if not restart' then                                        <<01869>>13700000
      move'to'dseg(bufdst,first'file/2,@fname/2,18);           <<01869>>13705000
                                                               <<01869>>13710000
<< at this point we've finished the initialization for the   >><<01869>>13715000
<< process. now need to set the status field in the logtab to>><<01869>>13720000
<< inact so users can use the process.                       >><<01869>>13725000
                                                               <<01869>>13730000
exchangedb(bufdst);       << to logbuff  >>                             13735000
release(dlogbuff(resource),null,1);                            <<01869>>13740000
resflag := false;                                              <<01869>>13765000
                                                               <<01869>>13770000
<< now we can get the logsir (preserving the locking order). >><<01869>>13775000
                                                               <<01869>>13780000
exchangedb(logdst);       << to logtab   >>                    <<01869>>13785000
a := getsir(logsir);                                           <<01869>>13790000
logtab(tabindex' + status) := inact;                           <<01869>>13795000
relsir(logsir,a);                                              <<01869>>13800000
                                                               <<01869>>13805000
exchangedb(bufdst);       << return to logbuff >>              <<01869>>13810000
obtain(dlogbuff(resource),null);                               <<01869>>13815000
resflag := true;                                               <<01869>>13820000
                                                               <<01869>>13825000
exchangedb(0);      << back to stack >>                                 13830000
msgno:=logprocruns;                                                     13835000
genmsg(setno,msgno,0,@procname,,,,,0);                         <<01869>>13840000
                                                                        13845000
exchangedb(bufdst);    << back to logbuff >>                            13850000
go getit;                                                      <<01869>>13855000
                                                               <<01869>>13860000
$page "Logging Process -- GetIt"                               <<01869>>13865000
getit:                                                                  13870000
                                                                        13875000
<< this is the main work loop. get here to see what there is >>         13880000
<< to do. for serial log files, transfer info from the disc  >>         13885000
<< buffer file to the serial log file. for disc log files,   >>         13890000
<< allocate the next extent.  db at logbuff.                 >>         13895000
                                                                        13900000
                                                                        13905000
if abnormal'exit then go wait1;                                <<01869>>13910000
                                                               <<01869>>13915000
logbuff(state) := act;                                                  13920000
                                                                        13925000
if logbuff(logtype) <> disc then                                        13930000
   begin             << serial logging >>                               13935000
   while dlogbuff(fsize) - dlogbuff(fspace') >=                         13940000
         double(blkfactor)   do                                         13945000
      begin                                                             13950000
      << there's something in the disc buffer file >>                   13955000
                                                                        13960000
      if resflag then                                                   13965000
         begin       << don't hold resource when blocked i/o >>         13970000
         release(dlogbuff(resource),null,1);                            13975000
         resflag := false;                                              14000000
         end;                                                           14005000
                                                                        14010000
     << move a block from the disc buffer file to the serial >>         14015000
     << log file.                                            >>         14020000
                                                                        14025000
      if not empty'disc'buffer(blksize) then                            14030000
         begin                                                          14035000
         if logbuff(logmsg) = writeerr then                             14040000
            begin                                                       14045000
            << if auto change for tape write error is ever   >><<01869>>14050000
            << implemented. should check logbuff(auto) to see>><<01869>>14055000
            << if auto change has been enabled. if it is,    >><<01869>>14060000
            << then goto auto'change'logfile. will have to   >><<01869>>14065000
            << decide how to put the changelog record into   >><<01869>>14070000
            << the file that just got a write error.         >><<01869>>14075000
                                                               <<01869>>14080000
            logbuff(msg) := suspend;                                    14085000
            end;                                                        14090000
         go wait1;                                                      14095000
         end;                                                           14100000
                                                                        14105000
      << if the user msg is discspace, then there was no room>>         14110000
      << in the buffer file to flush the memory buffer. the  >>         14115000
      << user process (doing the flush) owns the resource.   >>         14120000
                                                                        14125000
      if logbuff(usermsg) <> discspace and not resflag then             14130000
         begin                                                          14135000
         obtain(dlogbuff(resource),null);                               14140000
         resflag := true;                                               14145000
         end;                                                           14150000
                                                                        14155000
      << update global info to reflect the successful write. >>         14160000
                                                                        14165000
      outbufrec := outbufrec + double(blkfactor);                       14170000
      if outbufrec >= dlogbuff(fsize) then outbufrec := 0d;             14175000
      dlogbuff(fspace') := dlogbuff(fspace')+double(blkfactor);         14180000
                                                                        14185000
      logbuff(logmsg) := continue;                                      14190000
      wakeup';                                                          14195000
                                                                        14200000
      << if the message was discspace, user needed one block >>         14205000
      << cleared from the buffer file before flush could     >>         14210000
      << complete. since the user owns the resource, must go >>         14215000
      << to wait1 (and not loop thru here again) to avoid a  >>         14220000
      << possible deadlock over the resource.                >>         14225000
                                                                        14230000
      if logbuff(usermsg) = discspace then                              14235000
         begin                                                          14240000
         logbuff(usermsg) := continue;                                  14245000
         go wait1;                                                      14250000
         end;                                                           14255000
                                                               <<01869>>14260000
      go getit;                                                <<01869>>14265000
      end;                                                              14270000
                                                                        14275000
   go wait1;                                                            14280000
   end                                                                  14285000
else                                                                    14290000
   if logbuff(logtype) = disc then                                      14295000
      begin                                                             14300000
      if logbuff(usermsg) = discspace then                              14305000
         begin                                                          14310000
         << user needs another extent allocated >>                      14315000
                                                                        14320000
         logbuff(usermsg) := continue;                                  14325000
         if extnum + 1 > numext then                                    14330000
            begin                                                       14335000
            << opps...no more extents - eof >>                          14340000
                                                                        14345000
            if logbuff(auto) then                                       14350000
               begin                                                    14355000
               << o.k. change to new log file >>                        14360000
                                                               <<01869>>14365000
               logbuff(usermsg) := discspace;                  <<01869>>14370000
               go auto'change'logfile;                         <<01869>>14375000
               end;                                                     14380000
                                                                        14385000
            << eof and user did not want to automatically    >>         14390000
            << change to a new log file - too bad.           >>         14395000
                                                                        14400000
            if not notified then                                        14405000
               begin                                                    14410000
               ulerrcode := logfileeof;                        <<01869>>14415000
               exchangedb(0);                                  <<01869>>14420000
               genmsg(setno,ulerrcode,0,@fname,@procname,,,,0);<<01869>>14425000
               exchangedb(bufdst);                                      14430000
               notified := true;                                        14435000
               end;                                                     14440000
                                                                        14445000
            << not much to do but wait for all users to quit>>          14450000
                                                                        14455000
            logbuff(msg) := stop;                                       14460000
            logbuff(logmsg) := eofonlogfile;                            14465000
            dlogbuff(inbufrec) := dlogbuff(fsize);                      14470000
            wakeup';                                                    14475000
            go wait1;                                                   14480000
            end                                                         14485000
         else                                                           14490000
            begin                                                       14495000
            << there are more extents available to us >>                14500000
                                                                        14505000
            if not allocate'next'extent then                            14510000
               begin                                                    14515000
               << oh no...can't allocate the extent! >>                 14520000
                                                                        14525000
               abnormal'exit := true;                                   14530000
               go wait1;                                                14535000
               end;                                                     14540000
            end;                                                        14545000
         end;       << need another extent >>                  <<01869>>14550000
                                                                        14555000
      go wait1;                                                         14560000
      end;            << disc logging >>                                14565000
$page "Logging Process -- Requested'Changelog"                 <<01869>>14570000
                                                               <<01869>>14575000
                                                               <<01869>>14580000
requested'changelog:                                           <<01869>>14585000
                                                               <<01869>>14590000
if resflag then release(dlogbuff(resource),null,1);            <<01869>>14595000
                                                               <<01869>>14600000
<< get here if :changelog was issued. all info already updated <<01869>>14605000
<< in the logtab. need to release all resources to aquire them <<01869>>14610000
<< in the prober order to avoid a deadlock. db at logbuff.    ><<01869>>14615000
                                                               <<01869>>14620000
                                                               <<01869>>14625000
a := getsir(logsir);                                           <<01869>>14630000
obtain(dlogbuff(resource),null);                               <<01869>>14635000
user'requested'change := true;                                 <<01869>>14640000
resflag := true;                                               <<01869>>14645000
                                                               <<01869>>14650000
if abnormal'exit then                                          <<01869>>14655000
   begin                                                       <<01869>>14660000
   exchangedb(logdst);                                         <<01869>>14665000
   logtab(tabindex'+lgswitch) := false;                        <<01869>>14670000
   logtab(tabindex'+lgnewtype) := null;                        <<01869>>14675000
   writedseg(logdst);                                          <<01869>>14680000
   exchangedb(bufdst);                                         <<01869>>14685000
   logbuff(switch') := false;                                  <<01869>>14690000
   logbuff(newtype) := null;                                   <<01869>>14695000
   logbuff(logmsg) := writeerr;                                <<01869>>14700000
   logbuff(ulerr'code) := previous'error;                      <<01869>>14705000
   logbuff(logerr) := true;                                    <<01869>>14710000
   relsir(logsir,a);                                           <<01869>>14715000
   go wait1;                                                   <<01869>>14720000
   end;                                                        <<01869>>14725000
                                                               <<01869>>14730000
go change'logfile;                                             <<01869>>14735000
$page "Logging Process -- Auto'Changelog"                      <<01869>>14740000
auto'change'logfile:                                           <<01869>>14745000
                                                               <<01869>>14750000
<< get here if need to perform an auto changelog because the  ><<01869>>14755000
<< disc log file is full. (may also want to use this to do an ><<01869>>14760000
<< auto changelog if get a write error to the current log file><<01869>>14765000
<<                                                            ><<01869>>14770000
<< the resource is already owned by the process doing a flush ><<01869>>14775000
<< if the message is discspace.  db at logbuff.               ><<01869>>14780000
                                                               <<01869>>14785000
a := getsir(logsir);                                           <<01869>>14790000
                                                               <<01869>>14795000
if abnormal'exit then                                          <<01869>>14800000
   begin                                                       <<01869>>14805000
   logbuff(logmsg) := eofonlogfile;                            <<01869>>14810000
   logbuff(ulerr'code) := previous'error;                      <<01869>>14815000
   logbuff(logerr) := true;                                    <<01869>>14820000
   relsir(logsir,a);                                           <<01869>>14825000
   go wait1;                                                   <<01869>>14830000
   end;                                                        <<01869>>14835000
                                                               <<01869>>14840000
exchangedb(logdst);                                            <<01869>>14845000
logtab(tabindex'+lgswitch) := true;                            <<01869>>14850000
logtab(tabindex'+lgnewtype) := logtab(tabindex'+lgtype);       <<01869>>14855000
                                                               <<01869>>14860000
exchangedb(bufdst);                                            <<01869>>14865000
logbuff(switch') := true;                                      <<01869>>14870000
logbuff(newtype) := entry'(lgtype);                            <<01869>>14875000
                                                               <<01869>>14880000
                                                               <<01869>>14885000
go change'logfile;                                             <<01869>>14890000
$page "Logging Process -- Change'Logfile"                      <<01869>>14895000
change'logfile:                                                         14900000
                                                               <<01869>>14905000
switch'flag := true;                                           <<01869>>14910000
logbuff(state) := act;                                         <<01869>>14915000
restart' := false;                                             <<01869>>14920000
                                                               <<01869>>14925000
<< first get the new log file name and open new log file.    >><<01869>>14930000
                                                               <<01869>>14935000
get'new'file;                                                  <<01869>>14940000
                                                               <<01869>>14945000
<< now close the old log file. >>                              <<01869>>14950000
                                                               <<01869>>14955000
finish'changelog;                                              <<01869>>14960000
                                                               <<01869>>14965000
<< now set up the logbuff to reflect the characteristics of  >><<01869>>14970000
<< the new log file.                                         >><<01869>>14975000
                                                               <<01869>>14980000
set'up'logbuff;                                                <<01869>>14985000
                                                               <<01869>>14990000
<< now format the first record of the new log file. >>         <<01869>>14995000
                                                               <<01869>>15000000
format'first'file;                                             <<01869>>15005000
                                                               <<01869>>15010000
if errcode = 0 and ulerrcode =  0 then                         <<01869>>15015000
   begin     << no error -- success >>                         <<01869>>15020000
   logbuff(logerr) := false;                                   <<01869>>15025000
   logbuff(ulerr'code) := 0;                                   <<01869>>15030000
   logbuff(fserr'code) := 0;                                   <<01869>>15035000
   logbuff(usermsg) := continue;                               <<01869>>15040000
   logbuff(logmsg) := continue;                                <<01869>>15045000
   logbuff(switch') := false;                                  <<01869>>15050000
   logbuff(newtype) := null;                                   <<01869>>15055000
   end                                                         <<01869>>15060000
else                                                           <<01869>>15065000
   go changelog'error'recovery;                                <<01869>>15070000
                                                               <<01869>>15075000
switch'flag := false;                                          <<01869>>15080000
                                                               <<01869>>15085000
exchangedb(0);                                                 <<01869>>15090000
entry'(lgnewtype) := null;                                     <<01869>>15095000
entry'(lgswitch) := false;                                     <<01869>>15100000
move'to'dseg(logdst,tabindex',@entry',tentrysize-2);           <<01869>>15105000
writedseg(logdst);                                             <<01869>>15110000
                                                               <<01869>>15115000
<< now want to update the lidtab to reflect the new current >> <<01869>>15120000
<< log file in the set.                                     >> <<01869>>15125000
                                                               <<01869>>15130000
lid'typ.typ'previous := lid'typ.typ'current;                   <<01869>>15135000
lid'typ.typ'current := entry'(lgtype);                         <<01869>>15140000
alter'lid'entry(entry'(lgname),,fname,lid'typ);                <<01869>>15145000
                                                               <<01869>>15150000
genmsg(setno,changelog'ok,0,@procname,@old'file'name,@fname,   <<01869>>15155000
        ,,0);                                                  <<01869> 15160000
                                                               <<01869>>15165000
exchangedb(bufdst);                                            <<01869>>15170000
if logbuff(head'change'pin) <> 0 then                          <<01869>>15175000
   begin                                                       <<01869>>15180000
   awake(logbuff(head'change'pin),%20,0);                      <<01869>>15185000
   logbuff(head'change'pin) := 0;                              <<01869>>15210000
   end;                                                        <<01869>>15215000
                                                               <<01869>>15220000
relsir(logsir,a);                                              <<01869>>15225000
go wait1;                                                      <<01869>>15230000
$page "Logging Process -- Changelog'Error'Recovery"            <<01869>>15235000
changelog'error'recovery:                                      <<01869>>15240000
                                                               <<01869>>15245000
<< at this point this is very wishful thinking. maybe someday>><<01869>>15250000
<< we will be able to recover from an error.....             >><<01869>>15255000
                                                               <<01869>>15260000
exchangedb(0);                                                 <<01869>>15265000
go changelog'fail;                                             <<01869>>15270000
$page "Logging Process -- Changelog'Fail"                      <<01869>>15275000
changelog'fail:                                                <<01869>>15280000
                                                               <<01869>>15285000
<< get here if found a fatal error during a changelog. db is >><<01869>>15290000
<< at stack.                                                 >><<01869>>15295000
                                                               <<01869>>15300000
genmsg(setno,changelog'abort,0,@procname,,,,,0);               <<01869>>15305000
                                                               <<01869>>15310000
<< put old info back into logtab. >>                           <<01869>>15315000
                                                               <<01869>>15320000
deposit'filename(old'file'name,bentry'(lfname),               <<<01869>>15325000
       bentry'(lflockw),bentry'(lfgroup),bentry'(lfacct));     <<01869>>15330000
                                                               <<01869>>15335000
entry'(lgnewtype) := null;                                     <<01869>>15340000
entry'(lgswitch) := false;                                     <<01869>>15345000
                                                               <<01869>>15350000
move'to'dseg(logdst,tabindex',@entry',tentrysize-2);           <<01869>>15355000
writedseg(logdst);                                             <<01869>>15360000
exchangedb(bufdst);                                            <<01869>>15365000
                                                               <<01869>>15370000
if errcode = out'of'group'space or                             <<01869>>15375000
   errcode = out'of'account'space then                         <<01869>>15380000
   logbuff(logmsg) := discspace                                <<01869>>15385000
else                                                           <<01869>>15390000
   logbuff(logmsg) := writeerr;                                <<01869>>15395000
                                                               <<01869>>15400000
if logbuff(usermsg) = discspace then   << auto change on eof>> <<01869>>15405000
   logbuff(logmsg) := eofonlogfile;                            <<01869>>15410000
                                                               <<01869>>15415000
                                                               <<01869>>15420000
logbuff(logerr) := true;                                       <<01869>>15425000
logbuff(fserr'code) := errcode;                                <<01869>>15430000
logbuff(ulerr'code) := ulerrcode;                              <<01869>>15435000
                                                               <<01869>>15440000
logbuff(msg) := stop;                                          <<01869>>15445000
logbuff(switch') := false;                                     <<01869>>15450000
logbuff(logtype) := q'oldtype;                                 <<01869>>15455000
abnormal'exit := true;                                         <<01869>>15460000
switch'flag := false;                                          <<01869>>15465000
                                                               <<01869>>15470000
if logbuff(head'change'pin) <> 0 then                          <<01869>>15475000
   begin                                                       <<01869>>15480000
   awake(logbuff(head'change'pin),%20,0);                      <<01869>>15485000
   logbuff(head'change'pin) := 0;                              <<01869>>15490000
   end;                                                        <<01869>>15495000
                                                               <<01869>>15500000
relsir(logsir,a);                                              <<01869>>15505000
go wait1;                                                      <<01869>>15510000
                                                               <<01869>>15515000
$page "Logging Process -- Wait1"                               <<01869>>15520000
wait1:                                                                  15525000
                                                                        15530000
<< want to release any resources, wake up any sleeping users,>>         15535000
<< and then wait for another user to tell us to do something.>>         15540000
<< db at logbuff.                                            >>         15545000
                                                                        15550000
logbuff(state) := inact;                                                15555000
wakeup';                                                                15560000
                                                                        15565000
if resflag then                                                         15570000
   begin                                                                15575000
   release(dlogbuff(resource),null,1);                                  15580000
   resflag := false;                                                    15605000
   end;                                                                 15610000
                                                                        15615000
if logbuff(msg) = stop and logbuff(numuser) = 0                         15620000
   and not user'requested'change                               <<01869>>15625000
   and not logbuff(switch') then go stop1;                              15630000
                                                                        15635000
if logbuff(switch') then go requested'changelog;               <<01869>>15640000
                                                                        15645000
wait(%20,0);                                                   <<01869>>15650000
                                                               <<01869>>15655000
if logbuff(switch') then go requested'changelog;               <<01869>>15660000
user'requested'change := false;                                <<01869>>15665000
                                                                        15670000
if logbuff(usermsg) <> discspace then                                   15675000
   begin                                                                15680000
   obtain(dlogbuff(resource),null);                                     15685000
   resflag := true;                                                     15690000
   end;                                                                 15695000
                                                                        15700000
if logbuff(msg) = stop then                                             15705000
   begin                                                                15710000
   if logbuff(numuser) = 0 and not logbuff(switch')                     15715000
      then go stop1;                                                    15720000
                                                                        15725000
   << tell operator we will stop soon. >>                               15730000
                                                                        15735000
   if not notified then                                                 15740000
      begin                                                             15745000
      exchangedb(0);                                                    15750000
      genmsg(setno,loginuse,0,@procname,,,,,0);                         15755000
      exchangedb(bufdst);                                               15760000
      notified := true;                                                 15765000
      end;                                                              15770000
   end;                                                                 15775000
                                                                        15780000
                                                                        15785000
go getit;                                                               15790000
$page "Logging Process -- Stop1"                               <<01869>>15795000
stop1:                                                                  15800000
                                                               <<01869>>15805000
<< time to stop the user logging process. db at logbuff.     >>         15810000
                                                                        15815000
if not resflag then                                            <<01869>>15820000
   begin                                                       <<01869>>15825000
   resflag := true;                                            <<01869>>15830000
   obtain(dlogbuff(resource),null);                            <<01869>>15835000
   end;                                                        <<01869>>15840000
                                                               <<01869>>15845000
msgno:=logprocstop;                                                     15850000
                                                               <<01869>>15855000
<< if there was an error during a changelog, better not do   >><<01869>>15860000
<< anything - don't know what was updated and what was not.  >><<01869>>15865000
                                                               <<01869>>15870000
if abnormal'exit and logbuff(logerr) then                      <<01869>>15875000
   begin                                                       <<01869>>15880000
   release(dlogbuff(resource),null,1);                         <<01869>>15885000
   exchangedb (0);                                             <<01869>>15890000
   relentry (tabindex',0);                                     <<01869>>15895000
   go out;                                                     <<01869>>15900000
   end;                                                        <<01869>>15905000
                                                               <<01869>>15910000
                                                                        15915000
if logbuff(logtype) <> disc  then                              <<01869>>15920000
   begin    << stop the serial log file >>                     <<01869>>15925000
   <<format the last block>>                                            15930000
                                                               <<01869>>15935000
   if not formatted'trailer then                               <<01869>>15940000
      begin                                                    <<01869>>15945000
      format'trailer;                                          <<01869>>15950000
      formatted'trailer := true;                               <<01869>>15955000
      end;                                                     <<01869>>15960000
                                                               <<01869>>15965000
   flush(null,false);      << tell it we are the log process >><<01869>>15970000
   checkmsg;       << make sure all okay >>                    <<01869>>15975000
                                                               <<01869>>15980000
   count:=integer(dlogbuff(fsize)-dlogbuff(fspace'))*recsize;  <<01869>>15985000
                                                                        15990000
   exchangedb(0);    << back to stack >>                                15995000
                                                                        16000000
   do                                                          <<01869>>16005000
      begin                                                    <<01869>>16010000
     << may need more than one read/write to empty the disc>>  <<01869>>16015000
     << buffer file.                                       >>  <<01869>>16020000
                                                               <<01869>>16025000
      if count > blksize  then                                 <<01869>>16030000
         begin                                                 <<01869>>16035000
            tempcnt := count - blksize;                        <<01869>>16040000
            count := blksize;                                  <<01869>>16045000
         end                                                   <<01869>>16050000
      else  tempcnt := 0;                                      <<01869>>16055000
                                                               <<01869>>16060000
      if not empty'disc'buffer(count)                                   16065000
         then go close'serial'file;                                     16070000
                                                                        16075000
      count := tempcnt;     << # words left in disc buffer >>  <<01869>>16080000
      outbufrec := outbufrec + double(blkfactor);              <<01869>>16085000
      if outbufrec >= dlogbuff(fsize)  then outbufrec := 0d;   <<01869>>16090000
                                                               <<01869>>16095000
      end                                                      <<01869>>16100000
   until  count <= 0;                                          <<01869>>16105000
                                                               <<01869>>16110000
                                                               <<01869>>16115000
$page "Logging Process -- Change'Serial'Logfile"               <<01869>>16120000
close'serial'file:                                             <<01869>>16125000
                                                                        16130000
<< close files for tape logging - db is at stack >>            <<01869>>16135000
                                                                        16140000
fclose(buffileno,4,0);    << delete >>                                  16145000
fclose(fileno,0,0);                                                     16150000
if <> then                                                     <<01869>>16155000
   begin                                                       <<01869>>16160000
   fcheck(fileno,errcode);                                     <<01869>>16165000
   genmsg(fssetno,errcode,,,,,,,0);                            <<01869>>16170000
   genmsg(setno,fcloseerror,0,@procname);                      <<01869>>16175000
   end;                                                        <<01869>>16180000
   exchangedb(bufdst);    << to logbuff >>                              16185000
   release(dlogbuff(resource),null,1);                         <<01869>>16190000
                                                                        16215000
   exchangedb(0);     << back to stack >>                               16220000
   relentry(tabindex',0);                                      <<01869>>16225000
   reldataseg(bufdst);                                         <<01869>>16230000
   got'logbuff := false;                                       <<01869>>16235000
   go out;                                                     <<01869>>16240000
   end                                                                  16245000
else                                                                    16250000
begin                                                                   16255000
                                                               <<01869>>16260000
   << stop the disc logging process. >>                        <<01869>>16265000
                                                               <<01869>>16270000
   if logbuff(logtype) = disc  then                            <<01869>>16275000
   begin                                                                16280000
      if abnormal'exit and (extnum<=numext)                    <<01869>>16285000
         then go close'disc'file;                                       16290000
                                                               <<01869>>16295000
      << if we're on the last extent, then we can free up the>><<01869>>16300000
      << file space we've been saving.                       >><<01869>>16305000
                                                               <<01869>>16310000
      if not free'last'extent then                             <<01869>>16315000
      begin                                                    <<01869>>16320000
         if logbuff(extent) = logbuff(lastext')  and           <<01869>>16325000
            dlogbuff(fspace') < double(blkfactor)  then        <<01869>>16330000
         begin                                                 <<01869>>16335000
            << if this is the last block of the last extent, >><<01869>>16340000
            << then it's time to make the last record        >><<01869>>16345000
            << available.                                    >><<01869>>16350000
                                                               <<01869>>16355000
            dlogbuff(fsize) := dlogbuff(fsize) + 1d;           <<01869>>16360000
            dlogbuff(fspace') := dlogbuff(fspace') + 1d;       <<01869>>16365000
            logbuff(bspace) := logbuff(bspace) + 1;            <<01869>>16370000
                                                               <<01869>>16375000
            free'last'extent := true;                          <<01869>>16380000
         end;                                                  <<01869>>16385000
      end;                                                     <<01869>>16390000
                                                               <<01869>>16395000
      << now we can format the trailer record. >>              <<01869>>16400000
                                                               <<01869>>16405000
      if not formatted'trailer then                            <<01869>>16410000
      begin                                                    <<01869>>16415000
         format'trailer;                                       <<01869>>16420000
         formatted'trailer := true;                            <<01869>>16425000
      end;                                                     <<01869>>16430000
                                                               <<01869>>16435000
      << now flush the buffer (with the trailer record). >>    <<01869>>16440000
                                                               <<01869>>16445000
      flush(null,false);   << tell it we are the log process >><<01869>>16450000
      checkmsg;                                                <<01869>>16455000
                                                               <<01869>>16460000
      fpoint(fileno,(dlogbuff(trecs)-                          <<01869>>16465000
        dlogbuff(recs'in'prev))/double(blkfactor));            <<01869>>16470000
      if < then                                                <<01869>>16475000
      begin                                                    <<01869>>16480000
         exchangedb(0);       << back to stack >>                       16485000
         fcheck(fileno,errcode);                               <<01869>>16490000
         genmsg(fssetno,errcode,,,,,,,0);                      <<01869>>16495000
         genmsg(setno,fwriteerror,0,@procname,,,,,0);          <<01869>>16500000
         exchangedb(bufdst);       << back to logbuff >>                16505000
      end;                                                     <<01869>>16510000
                                                               <<01869>>16515000
$page "Logging Process -- Close'Disc'Logfile"                  <<01869>>16520000
close'disc'file:                                               <<01869>>16525000
            << db at logbuff >>                                         16530000
                                                                        16535000
   if resflag then                                                      16540000
      begin                                                             16545000
      release(dlogbuff(resource),null,1);                      <<01869>>16550000
      resflag := false;                                                 16575000
      end;                                                              16580000
                                                                        16585000
                                                                        16590000
      exchangedb(0);     << back to stack >>                            16595000
         fcontrol(fileno,set'eof,dummy);  << write eof >>      <<01869>>16600000
         if <> then                                            <<01869>>16605000
         begin                                                 <<01869>>16610000
            fcheck(fileno,errcode);                            <<01869>>16615000
            genmsg(fssetno,errcode,,,,,,,0);                   <<01869>>16620000
            genmsg(setno,fwriteerror,0,@procname,,,,,0);       <<01869>>16625000
         end;                                                  <<01869>>16630000
                                                               <<01869>>16635000
      fclose(fileno,0,0);                                               16640000
      if <> then                                               <<01869>>16645000
      begin                                                    <<01869>>16650000
         fcheck(fileno,errcode);                               <<01869>>16655000
         genmsg(fssetno,errcode,,,,,,,0);                      <<01869>>16660000
         genmsg(setno,fwriteerror,0,@procname,,,,,0);          <<01869>>16665000
      end;                                                     <<01869>>16670000
                                                               <<01869>>16675000
      relentry(tabindex',0);                                            16680000
      reldataseg(bufdst);                                      <<01869>>16685000
      got'logbuff := false;                                    <<01869>>16690000
   end;     <<disc logging - stop>>                            <<01869>>16695000
end;                                                                    16700000
                                                               <<01869>>16705000
go out;                                                        <<01869>>16710000
$page "Logging Process -- Init'Fail"                           <<01869>>16715000
init'fail:                                                     <<01869>>16720000
                                                               <<01869>>16725000
<< db at logbuff >>                                            <<01869>>16730000
release(dlogbuff(resource),null,1);                            <<01869>>16735000
exchangedb(0);                                                 <<01869>>16760000
relentry(tabindex',0);                                         <<01869>>16765000
if restart' then                                               <<01869>>16770000
   msgno := cantrestart                                        <<01869>>16775000
else                                                           <<01869>>16780000
   msgno := cantstart;                                         <<01869>>16785000
                                                               <<01869>>16790000
go out;                                                        <<01869>>16795000
                                                               <<01869>>16800000
                                                               <<01869>>16805000
                                                               <<01869>>16810000
                                                                        16815000
                                                                        16820000
out:                                                                    16825000
                                                               <<01869>>16830000
exchangedb(0);    << make sure at stack >>                              16835000
                                                               <<01869>>16840000
if got'logbuff then                                            <<01869>>16845000
   reldataseg(bufdst);                                         <<01869>>16850000
                                                               <<01869>>16855000
exchangedb(logdst);                                             <<s617>>16860000
a:=getsir(logsir);                                              <<s617>>16865000
logtab(dstflag) := bufdst;                                      <<s617>>16870000
relsir(logsir,a);                                               <<s617>>16875000
exchangedb(0);                                                  <<s617>>16880000
genmsg(setno,msgno,%0,@procname,,,,,0); <<tell operator fini>>          16885000
end; <<ulogproc>>                                                       16890000
$page "Power Fail Recovery"                                    <<01869>>16895000
logical procedure recpfail(fileno,recnum,tldev,first'block);   <<01869>>16900000
   value fileno,recnum,tldev,first'block;                      <<01869>>16905000
   integer fileno,tldev;                                       <<01869>>16910000
   logical first'block;                                        <<01869>>16915000
   double recnum;                                              <<01869>>16920000
   option internal;                                            <<01869>>16925000
                                                               <<01869>>16930000
begin                                                          <<01869>>16935000
                                                               <<01869>>16940000
<< called from ulogproc when writting to the tape logging    >><<01869>>16945000
<< file and a powerfail error occurred. we want to rewind to >><<01869>>16950000
<< load point (lp) and then read each block until we find the>><<01869>>16955000
<< last good block before the power failed.  at that point   >><<01869>>16960000
<< we can try to re-write the block.                         >><<01869>>16965000
<<                                                           >><<01869>>16970000
<< since the logging file is a labeled tape and contains only>><<01869>>16975000
<< one file (the log file) we must rewind the tape back to   >><<01869>>16980000
<< lp, then forward space over the label stuff to the        >><<01869>>16985000
<< tape mark (tm).                                           >><<01869>>16990000
<<                                                           >><<01869>>16995000
<< format of a labeled tape:                                 >><<01869>>17000000
<<    [lp] [vol1] [hdr1] [hd2]  [tm] [...data......]         >><<01869>>17005000
<<                                                           >><<01869>>17010000
<<  db is at the stack.                                      >><<01869>>17015000
<<                                                           >><<01869>>17020000
<< entry:                                                    >><<01869>>17025000
<<   recnum  - record number for block trying to write when  >><<01869>>17030000
<<             power fail occurred.                          >><<01869>>17035000
<<   tldev   - ldev for the tape device.                     >><<01869>>17040000
<<   first'block - true if were writing the first block to   >><<01869>>17045000
<<                 tape when the power fail occurred.        >><<01869>>17050000
                                                               <<01869>>17055000
<< returns:                                                  >><<01869>>17060000
<<    true - block successfully rewritten to log file.       >><<01869>>17065000
<<    false- some other error occurred. log file may not     >><<01869>>17070000
<<           completely be recovered.                        >><<01869>>17075000
                                                               <<01869>>17080000
                                                               <<01869>>17085000
                                                               <<01869>>17090000
double                                                         <<01869>>17095000
   stat,           << status return from attachio >>           <<01869>>17100000
   record;         << rec # before the one to write >>         <<01869>>17105000
                                                               <<01869>>17110000
integer                                                        <<01869>>17115000
   stat0 = stat + 0,                                           <<01869>>17120000
   errcode;        << return from fcheck >>                    <<01869>>17125000
                                                               <<01869>>17130000
logical array taperec(0:recsizem1) = q;                        <<01869>>17135000
double array dtaperec(*) = taperec;                            <<01869>>17140000
                                                               <<01869>>17145000
equate                                                         <<01869>>17150000
   syspfail = %63,   << sys powerfail code - from attachio >>  <<01869>>17155000
   tapepfail= %213,  << device powerfail   - from attachio >>  <<01869>>17160000
   chanel'timeout=%144,<< channel timed out after the pf   >>  <<01869>>17165000
   success  = 1,      << general status  -  from attachio >>   <<01869>>17170000
   blockedio= 1;                                               <<01869>>17175000
                                                               <<01869>>17180000
                                                               <<01869>>17185000
                                                               <<01869>>17190000
                                                               <<01869>>17195000
recpfail := false;                                             <<01869>>17200000
                                                               <<01869>>17205000
<< if this was the 2nd write (recnum=32d), then need to stop>> <<01869>>17210000
<< re-reading the file when we've found the 1st block.      >> <<01869>>17215000
                                                               <<01869>>17220000
if not first'block then                                        <<01869>>17225000
   record := recnum - double(blkfactor);                       <<01869>>17230000
                                                               <<01869>>17235000
                                                               <<01869>>17240000
                                                               <<01869>>17245000
powerfail:                                                     <<01869>>17250000
                                                               <<01869>>17255000
   << make sure we'll still be posting device buffer on each>> <<01869>>17260000
   << write to tape.                                        >> <<01869>>17265000
                                                               <<01869>>17270000
   fsetmode(fileno,post'tape'buffer);                          <<01869>>17275000
                                                               <<01869>>17280000
   << tell the operator to reset the tape drive and place    >><<01869>>17285000
   << it back on-line.                                       >><<01869>>17290000
                                                               <<01869>>17295000
   genmsg(setno,tpowerfail,%10000,tldev,,,,,0);                <<01869>>17300000
                                                               <<01869>>17305000
   << rewind to lp. (fcontrol won't do this o labeled tape). >><<01869>>17310000
                                                               <<01869>>17315000
retry:                                                         <<01869>>17320000
                                                               <<01869>>17325000
    stat:=attachio(tldev,0,0,0,rewind,0,0,0,flags);            <<01869>>17330000
    if stat0.(13:3) <> success then                            <<01869>>17335000
    begin                                                      <<01869>>17340000
       if stat0.(8:8) = chanel'timeout then go retry;          <<01869>>17345000
       if stat0.(8:8) = syspfail or stat0.(8:8) = tapepfail    <<01869>>17350000
           then go powerfail                                   <<01869>>17355000
       else                                                    <<01869>>17360000
       begin                                                   <<01869>>17365000
          errcode := iostat(stat0);                            <<01869>>17370000
          genmsg(fssetno,errcode,,,,,,,0);                     <<01869>>17375000
          return;                                              <<01869>>17380000
       end;                                                    <<01869>>17385000
                                                               <<01869>>17390000
    end;                                                       <<01869>>17395000
                                                               <<01869>>17400000
    << skip over label stuff to tm >>                          <<01869>>17405000
                                                               <<01869>>17410000
    stat:=attachio(tldev,0,0,0,forwardspace,0,0,0,flags);      <<01869>>17415000
    if stat0.(13:3) <> success then                            <<01869>>17420000
    begin                                                      <<01869>>17425000
       if stat0.(8:8) = chanel'timeout then go retry;          <<01869>>17430000
       if stat0.(8:8) = syspfail or stat0.(8:8) = tapepfail    <<01869>>17435000
           then go powerfail                                   <<01869>>17440000
       else                                                    <<01869>>17445000
       begin                                                   <<01869>>17450000
          errcode := iostat(stat0);                            <<01869>>17455000
          genmsg(fssetno,errcode,,,,,,,0);                     <<01869>>17460000
          return;                                              <<01869>>17465000
       end;                                                    <<01869>>17470000
                                                               <<01869>>17475000
    end;                                                       <<01869>>17480000
                                                               <<01869>>17485000
                                                               <<01869>>17490000
    << if we power failed on the first write to tape then    >><<01869>>17495000
    << we need to skip over the re-reading of the file.      >><<01869>>17500000
                                                               <<01869>>17505000
    << may be a problem if not the first file in the set. >>   <<01869>>17510000
                                                               <<01869>>17515000
    if not first'block then                                    <<01869>>17520000
    begin                                                      <<01869>>17525000
                                                               <<01869>>17530000
    << now we're positioned to start reading the data from  >> <<01869>>17535000
    << the file to find the last good block.  will read the >> <<01869>>17540000
    << first record of each block to find the record number >> <<01869>>17545000
    << of that block.  (the 1st double word of the record   >> <<01869>>17550000
    << contains the record number).                         >> <<01869>>17555000
    << we must use attachio to perform the read since the   >> <<01869>>17560000
    << file system will not allow an fread after an fwrite  >> <<01869>>17565000
    << (fs does not know about the rewind/forward space).   >> <<01869>>17570000
                                                               <<01869>>17575000
       do                                                      <<01869>>17580000
       begin                                                   <<01869>>17585000
          stat:=attachio(tldev,0,0,@taperec,read,recsize,0,0,  <<01869>>17590000
                         flags);                               <<01869>>17595000
          if stat0.(13:3) <> success then                      <<01869>>17600000
          begin                                                <<01869>>17605000
             if stat0.(8:8) = chanel'timeout then go retry;    <<01869>>17610000
             if stat0.(8:8) = syspfail or                      <<01869>>17615000
                stat0.(8:8) = tapepfail  then go powerfail     <<01869>>17620000
             else                                              <<01869>>17625000
             begin                                             <<01869>>17630000
                errcode := iostat(stat0);                      <<01869>>17635000
                genmsg(fssetno,errcode,,,,,,,0);               <<01869>>17640000
                return;                                        <<01869>>17645000
             end;                                              <<01869>>17650000
          end;                                                 <<01869>>17655000
       end                                                     <<01869>>17660000
       until dtaperec = record;                                <<01869>>17665000
    end;                                                       <<01869>>17670000
                                                               <<01869>>17675000
    << at this point we've found the last complete block    >> <<01869>>17680000
    << before the power fail. try to write the block again. >> <<01869>>17685000
                                                               <<01869>>17690000
    fwrite(fileno,buffarea,blksize,0);                         <<01869>>17695000
    if <> then                                                 <<01869>>17700000
    begin                                                      <<01869>>17705000
       fcheck(fileno,errcode);                                 <<01869>>17710000
       if errcode = syspowerfail  or  errcode = tapepowerfail  <<01869>>17715000
           then go powerfail                                   <<01869>>17720000
       else                                                    <<01869>>17725000
       begin                                                   <<01869>>17730000
          genmsg(fssetno,errcode,,,,,,,0);                     <<01869>>17735000
          return;                                              <<01869>>17740000
       end;                                                    <<01869>>17745000
                                                               <<01869>>17750000
    end;                                                       <<01869>>17755000
                                                               <<01869>>17760000
    << if we finally make it here, recovery is successful.  >> <<01869>>17765000
                                                               <<01869>>17770000
    recpfail := true;                                          <<01869>>17775000
                                                               <<01869>>17780000
end;                                                           <<01869>>17785000
$page "Warmstart Recovery declarations"                                 17790000
procedure reclog;                                                       17795000
option privileged,uncallable;                                           17800000
begin                                                                   17805000
                                                                        17810000
comment                                                        <<01869>>17815000
                                                               <<01869>>17820000
called during a warmstart to recover any active user loggging  <<01869>>17825000
files. will search the logtab for an entry, open the file      <<01869>>17830000
associated with this entry, re-read the file until the last    <<01869>>17835000
good record is found, then will write a log crash record to the<<01869>>17840000
file, print a message to the console telling how many records  <<01869>>17845000
were recovered, update the eof marker in the file label to     <<01869>>17850000
the corrert setting, and close the file.                       <<01869>>17855000
this will be repeated until all active files are recovered.    <<01869>>17860000
                                                               <<01869>>17865000
it is important to realize that any information in the buffer  <<01869>>17870000
area of the logging buffer will be lost if the system crashes. <<01869>>17875000
;                                                              <<01869>>17880000
                                                                        17885000
   <<recovers user logging file during warmstart>>                      17890000
                                                                        17895000
equate                                                         <<01869>>17900000
  feof      =  %12,        << attachio found eof >>            <<01869>>17905000
  forwrd    =  forwardspace;  << forward space file >>         <<01869>>17910000
   double                                                      <<01869>>17915000
      stat;          << status return from attachio >>         <<01869>>17920000
                                                               <<01869>>17925000
   integer                                                     <<01869>>17930000
      i,                                                       <<01869>>17935000
      errcode,                                                 <<01869>>17940000
      stat0  =  stat + 0;                                      <<01869>>17945000
                                                               <<01869>>17950000
   integer                                                     <<01869>>17955000
     logging'type,                                             <<01869>>17960000
     save'tabindex,                                            <<01869>>17965000
     tabindex;                                                 <<01869>>17970000
                                                               <<01869>>17975000
   logical                                                     <<01869>>17980000
      first,                                                   <<01869>>17985000
      names'match,                                             <<01869>>17990000
      switch'flag;                                             <<01869>>17995000
                                                               <<01869>>18000000
                                                                        18005000
<< currrec is the record number expected next >>               <<01869>>18010000
                                                               <<01869>>18015000
   double currrec,lastrec,recnum,eof;                                   18020000
double stopper;                                                <<01869>>18025000
   integer buffileno,logfileno;                                         18030000
   logical valid,parm,eoforerr;                                         18035000
double numrecovered;                                           <<01869>>18040000
   logical b;                                                           18045000
   integer numopen,numclose,len,next'tabindex;                 <<01869>>18050000
   byte pointer binrec;                                        <<01869>>18055000
   logical pointer inrec,outrec;                                        18060000
   double pointer dinrec;                                      <<01869>>18065000
   integer tapedev;                                            <<01869>>18070000
   logical notified;                                           <<01869>>18075000
   byte array recov'fname(0:36);                               <<01869>>18080000
   byte array save'fname(0:36);                                <<01869>>18085000
   byte array lost'fname(0:36);                                <<01869>>18090000
                                                               <<01869>>18095000
                                                               <<01869>>18100000
   byte array bufname(0:16) = q;                               <<01869>>18105000
   byte array dev(0:8);                                        <<01869>>18110000
   byte array forms(0:8);                                      <<01869>>18115000
   byte array procname(0:8) = q;                               <<01869>>18120000
   byte array output1(0:12);                                   <<01869>>18125000
   byte array output2(0:6);                                    <<01869>>18130000
   byte array output3(0:6);                                    <<01869>>18135000
                                                               <<01869>>18140000
   array entry'(0:tentrysize-1) = q;                           <<01869>>18145000
   byte array bentry'(*) = entry';                             <<01869>>18150000
                                                                        18155000
                                                                        18160000
$page "Warmstart Recovery Subroutines"                                  18165000
subroutine checkrecord;                                        <<01869>>18170000
begin                                                          <<01869>>18175000
                                                               <<01869>>18180000
<< checks each record for checkblock. >>                       <<01869>>18185000
                                                               <<01869>>18190000
valid := false;                                                <<01869>>18195000
if first then                                                  <<01869>>18200000
   begin                                                       <<01869>>18205000
   if inrec(code).(8:8) <> header and                          <<01869>>18210000
      inrec(code).(8:8) <> rstart and                          <<01869>>18215000
      inrec(code).(8:8) <> first'code then                     <<01869>>18220000
      return;                                                  <<01869>>18225000
                                                               <<01869>>18230000
   if inrec(code).(8:8) = first'code then                      <<01869>>18235000
      currrec := dinrec(rnum);                                 <<01869>>18240000
   end;                                                        <<01869>>18245000
                                                               <<01869>>18250000
if inrec(code).(8:8) <> first'code then                        <<01869>>18255000
   currrec := currrec + 1d;                                    <<01869>>18260000
                                                               <<01869>>18265000
if dinrec(rnum) <> currrec then return;                        <<01869>>18270000
                                                               <<01869>>18275000
<< if we find a changelog record, we will consider it an error <<01869>>18280000
<< i.e. a changelog was in progress when the system crashed.   <<01869>>18285000
<< maybe in the future will be able to finish the changelog    <<01869>>18290000
<< during the warmstart recovery.                              <<01869>>18295000
                                                               <<01869>>18300000
if inrec(code).(8:8) = next'code then return;                  <<01869>>18305000
                                                               <<01869>>18310000
<< now calculate the checksums >>                              <<01869>>18315000
                                                               <<01869>>18320000
tos := -1;                                                     <<01869>>18325000
x := recsizem1;                                                <<01869>>18330000
do                                                             <<01869>>18335000
   begin                                                       <<01869>>18340000
   if x <> cksum then                                          <<01869>>18345000
      tos := tos xor inrec(x);                                 <<01869>>18350000
   end                                                         <<01869>>18355000
until (x := x-1) < 0;                                          <<01869>>18360000
                                                               <<01869>>18365000
if tos <> inrec(cksum) then return;                            <<01869>>18370000
                                                               <<01869>>18375000
if inrec(code).(8:8) = open then numopen := numopen + 1;       <<01869>>18380000
if inrec(code).(8:8) = close then numclose := numclose + 1;    <<01869>>18385000
                                                               <<01869>>18390000
numrecovered := numrecovered + 1d;                             <<01869>>18395000
valid := true;                                                 <<01869>>18400000
                                                               <<01869>>18405000
end;       << subroutine checkrecord >>                        <<01869>>18410000
                                                                        18415000
                                                                        18420000
                                                                        18425000
                                                                        18430000
subroutine checkblock;                                                  18435000
begin                                                                   18440000
                                                                        18445000
                                                                        18450000
<<checks a block read from the logfile or buffer>>                      18455000
                                                                        18460000
                                                                        18465000
   valid:=true;                                                         18470000
   i:=0;                                                                18475000
   do                                                                   18480000
   begin                                                                18485000
      checkrecord;                                                      18490000
      if valid then                                                     18495000
      begin                                                             18500000
         @inrec:=@inrec+recsize;                               <<01869>>18505000
         @dinrec:=@inrec;                                               18510000
         first := false;                                       <<01869>>18515000
      end;                                                              18520000
   end until not valid or (i:=i+1)>=blkfactor;                          18525000
end;                                                                    18530000
                                                                        18535000
                                                                        18540000
                                                                        18545000
                                                                        18550000
                                                                        18555000
subroutine formatcrash;                                                 18560000
begin                                                                   18565000
                                                                        18570000
<<formats a crash record>>                                              18575000
                                                                        18580000
<< output one crach record, then fill remainder of the     >>  <<01869>>18585000
<< block with null records.                                >>  <<01869>>18590000
<< i = last valid record # found by checkblock >>              <<01869>>18595000
                                                                        18600000
   @inrec:=@buffarea+i*recsize;                                <<01869>>18605000
   @dinrec:=@inrec;                                                     18610000
   inrec:="  ";                                                <<01869>>18615000
   move inrec(1):=inrec, ((blkfactor-i)*recsize-1);            <<01869>>18620000
   inrec(code):=crash;                                                  18625000
   do                                                                   18630000
   begin                                                                18635000
   inrec(date) := calendar;                                    <<01869>>18640000
   dinrec(time):=clock;                                                 18645000
   dinrec(rnum):=currrec:=currrec+1d;                                   18650000
      x:=recsizem1;                                            <<01869>>18655000
      tos:=-1;                                                          18660000
      do                                                                18665000
      begin                                                             18670000
         if x<>cksum then                                               18675000
         tos:=tos xor inrec(x);                                         18680000
      end until (x:=x-1) < 0;                                           18685000
      inrec(cksum):=tos;                                                18690000
      @inrec:=@inrec+recsize;                                  <<01869>>18695000
      @dinrec:=@inrec;                                                  18700000
                                                                        18705000
   end until(i:=i+1) >= blkfactor;                                      18710000
end;                                                                    18715000
$page "Warmstart Recovery -- Get'File'Names"                   <<01869>>18720000
subroutine get'file'names;                                     <<01869>>18725000
begin                                                          <<01869>>18730000
                                                               <<01869>>18735000
<< called to get the file name to recover - from the lidtab. >><<01869>>18740000
<< will also determine if a changelog was in progress when   >><<01869>>18745000
<< the system went down and print an appropriate message on  >><<01869>>18750000
<< the console explaining that the changelog was lost.       >><<01869>>18755000
                                                               <<01869>>18760000
fentry(procname,,recov'fname,,,logging'type);                  <<01869>>18765000
logging'type := logging'type.typ'current;                      <<01869>>18770000
recov'fname(36) := 0;                                          <<01869>>18775000
                                                               <<01869>>18780000
save'tabindex := tabindex;                                     <<01869>>18785000
tabindex := 0;                                                 <<01869>>18790000
                                                               <<01869>>18795000
<< now get info from the logtab. this will tell us if there  >><<01869>>18800000
<< was a changelog in progress and perhaps what the new log  >><<01869>>18805000
<< file name would have been.                                >><<01869>>18810000
                                                               <<01869>>18815000
move'from'dseg(@entry',logdst,save'tabindex,tentrysize);       <<01869>>18820000
extract'filename(lost'fname,bentry'(lfname),bentry'(lflockw),  <<01869>>18825000
        bentry'(lfgroup),bentry'(lfacct));                     <<01869>>18830000
lost'fname(36) := 0;                                           <<01869>>18835000
                                                               <<01869>>18840000
<< if the filenames are not the same or the switch' flag is  >><<01869>>18845000
<< set, then there was a changelog in progress.              >><<01869>>18850000
                                                               <<01869>>18855000
if recov'fname <> lost'fname, (36) then                        <<01869>>18860000
   begin                                                       <<01869>>18865000
   switch'flag := true;                                        <<01869>>18870000
   names'match := false;                                       <<01869>>18875000
   end                                                         <<01869>>18880000
else                                                           <<01869>>18885000
   begin                                                       <<01869>>18890000
   names'match := true;                                        <<01869>>18895000
   if entry'(lgswitch) then                                    <<01869>>18900000
      switch'flag := true                                      <<01869>>18905000
   else                                                        <<01869>>18910000
      switch'flag := false;                                    <<01869>>18915000
   end;                                                        <<01869>>18920000
                                                               <<01869>>18925000
if logging'type <> disc then                                   <<01869>>18930000
   begin                                                       <<01869>>18935000
   move recov'fname := recov'fname while an, 1;                <<01869>>18940000
   move * := 0;                                                <<01869>>18945000
   end;                                                        <<01869>>18950000
                                                               <<01869>>18955000
if entry'(lgswitch) and entry'(lgnewtype) <> disc or           <<01869>>18960000
   not entry'(lgswitch) and entry'(lgtype) <> disc then        <<01869>>18965000
   begin                                                       <<01869>>18970000
   move lost'fname := lost'fname while an, 1;                  <<01869>>18975000
   move * := 0;                                                <<01869>>18980000
   end;                                                        <<01869>>18985000
                                                               <<01869>>18990000
   move save'fname := recov'fname, (36);                       <<01869>>18995000
   del'lockword(save'fname);                                   <<01869>>19000000
   save'fname (26) := 0;                                       <<01869>>19005000
                                                               <<01869>>19010000
<< if there was a changelog in progress, now want to print   >><<01869>>19015000
<< message on the console explaning that it was lost.        >><<01869>>19020000
                                                               <<01869>>19025000
if switch'flag then                                            <<01869>>19030000
   begin                                                       <<01869>>19035000
   if entry'(lgswitch) and entry'(lgnewtype) = disc or         <<01869>>19040000
      not entry'(lgswitch) and entry'(lgtype) = disc then      <<01869>>19045000
      begin                                                    <<01869>>19050000
      << will purge the "new" log file that is lost. if the  >><<01869>>19055000
      << new log file would have been serial, then there is  >><<01869>>19060000
      << nothing to purge.                                   >><<01869>>19065000
                                                               <<01869>>19070000
      if not names'match then                                  <<01869>>19075000
         begin                                                 <<01869>>19080000
         move dev := "DISC ";                                  <<01869>>19085000
         logfileno := fopen(lost'fname,%2005,%524,dev);        <<01869>>19090000
         fclose(logfileno,4,0);     << delete >>               <<01869>>19095000
         end;                                                  <<01869>>19100000
      end;                                                     <<01869>>19105000
                                                               <<01869>>19110000
   del'lockword(lost'fname);                                   <<01869>>19115000
   lost'fname (26) := 0;                                       <<01869>>19120000
   if not names'match then                                     <<01869>>19125000
      genmsg(setno,changelog'lost1,0,@save'fname,@lost'fname,  <<01869>>19130000
             @procname,,,0)                                    <<01869>>19135000
   else                                                        <<01869>>19140000
      genmsg(setno,changelog'lost2,0,@procname,,,,,0);         <<01869>>19145000
   end;                                                        <<01869>>19150000
                                                               <<01869>>19155000
tabindex := save'tabindex;                                     <<01869>>19160000
                                                               <<01869>>19165000
end;       << subroutine get'file'names >>                     <<01869>>19170000
$page "Warmstart Recovery"                                     <<01869>>19175000
   << turn traps off >>                                        <<01869>>19180000
                                                               <<01869>>19185000
   assemble(pshr %10);                                                  19190000
   tos.(2:1):=0;                                                        19195000
   assemble(setr %10);                                                  19200000
                                                               <<01869>>19205000
   move output1:="  ";                                                  19210000
   move output1(1):=output1,(18);                                       19215000
   notified := false;                                          <<01869>>19220000
   exchangedb(logdst);    << to logtab >>                               19225000
   b:=getsir(logsir);                                                   19230000
   if logtab(numentries) = 0 then                                       19235000
   begin                                                                19240000
      <<logging not in use, go exit>>                                   19245000
      relsir(logsir,b);                                                 19250000
      go out;                                                           19255000
   end;                                                                 19260000
                                                                        19265000
   if (tabindex:=logtab(inuse)) = null  then                   <<01869>>19270000
   begin                                                                19275000
      relsir(logsir,b);                                                 19280000
      go out;                                                           19285000
   end;                                                                 19290000
   do logtab(status):=recovering                               <<01869>>19295000
    until (tabindex:=logtab(next)) = null;                     <<01869>>19300000
                                                               <<01869>>19305000
   tabindex:=logtab(inuse);                                             19310000
   relsir(logsir,b);                                                    19315000
                                                               <<01869>>19320000
   do                                                                   19325000
      begin           <<recover loop>>                         <<01869>>19330000
      i := 0;                                                  <<01869>>19335000
      do procname(i) := blogtab(lgname+i) until (i:=i+1) >= 8; <<01869>>19340000
      procname(8) := 0;                                        <<01869>>19345000
                                                               <<01869>>19350000
      i := 0;                                                  <<01869>>19355000
      do bufname(i) := blogtab(bname+i) until (i:=i+1) >= 8;   <<01869>>19360000
                                                               <<01869>>19365000
      switch'flag := false;                                    <<01869>>19370000
      next'tabindex := logtab(next);                           <<01869>>19375000
      exchangedb(0);                                           <<01869>>19380000
                                                               <<01869>>19385000
      get'file'names;                                          <<01869>>19390000
      genmsg(setno,logrecov,0,@save'fname,@procname,,,,0);     <<01869>>19395000
                                                               <<01869>>19400000
      i := 0;                                                  <<01869>>19405000
      first := true;                                           <<01869>>19410000
      notified := false;                                       <<01869>>19415000
      numopen := 0;                                            <<01869>>19420000
      numclose := 0;                                           <<01869>>19425000
      currrec := 0d;                                           <<01869>>19430000
      lastrec := 0d;                                           <<01869>>19435000
      recnum := 0d;                                            <<01869>>19440000
      numrecovered := 0d;                                      <<01869>>19445000
                                                               <<01869>>19450000
      @inrec := @buffarea;                                     <<01869>>19455000
      @dinrec := @inrec;                                       <<01869>>19460000
      @binrec := @inrec * 2;                                   <<01869>>19465000
                                                               <<01869>>19470000
      if logging'type = disc then                              <<01869>>19475000
      begin                                   <<disc logging>>          19480000
         move dev:="DISC ";                                             19485000
                                                               <<01869>>19490000
         << log file: old perm, fixed, ascii, read/write,    >><<01869>>19495000
         << multi-rec, no buf, exc, no :file.                >><<01869>>19500000
                                                               <<01869>>19505000
         logfileno:=fopen(recov'fname,%2005,%524,dev);         <<01869>>19510000
         if <> then                                                     19515000
         begin                                                          19520000
            <<unable to open logging file>>                             19525000
            fcheck(logfileno,errcode);                         <<01869>>19530000
            genmsg(fssetno,errcode,,,,,,,0);                   <<01869>>19535000
            genmsg(setno,uopenfailed,0,@save'fname,@procname,  <<01869>>19540000
                   ,,,0);                                      <<01869>>19545000
            genmsg(setno,nologrec,0,@save'fname,@procname,     <<01869>>19550000
                   ,,,0);                                      <<01869>>19555000
            notified := true;                                  <<01869>>19560000
            go nextone;                                        <<01869>>19565000
         end;                                                           19570000
         fgetinfo(logfileno,,,,,,,,,,eof);                              19575000
         if <> then                                            <<01869>>19580000
         begin                                                 <<01869>>19585000
            fcheck(logfileno,errcode);                         <<01869>>19590000
            genmsg(fssetno,errcode,,,,,,,0);                   <<01869>>19595000
            genmsg(setno,logrecerr,0,@save'fname,@procname,    <<01869>>19600000
                   ,,,0);                                      <<01869>>19605000
            genmsg(setno,nologrec,0,@save'fname,@procname,     <<01869>>19610000
                   ,,,0);                                      <<01869>>19615000
            notified := true;                                  <<01869>>19620000
            go nextone;                                        <<01869>>19625000
         end;                                                  <<01869>>19630000
         do                                                             19635000
         begin                                                          19640000
            fread(logfileno,buffarea,blksize);                          19645000
            if <> then eoforerr:=true;                                  19650000
            @inrec:=@buffarea;                                          19655000
            @dinrec:=@buffarea;                                         19660000
            checkblock;                                                 19665000
            if not valid then                                           19670000
            begin                                                       19675000
               if first then                                   <<01869>>19680000
               begin                                           <<01869>>19685000
                  genmsg(setno,logempty,0,@save'fname,         <<01869>>19690000
                         @procname,,,,0);                      <<01869>>19695000
                  notified := true;                            <<01869>>19700000
                  go nextone;                                  <<01869>>19705000
               end;                                            <<01869>>19710000
                                                               <<01869>>19715000
               if not eoforerr then fspace(logfileno,-1);               19720000
               currrec:=currrec-1d;                                     19725000
               formatcrash;                                             19730000
               fwrite(logfileno,buffarea,blksize,0);                    19735000
               if < then                                       <<01869>>19740000
               begin                                           <<01869>>19745000
                  fcheck(logfileno,errcode);                   <<01869>>19750000
                  genmsg(fssetno,errcode,,,,,,,0);             <<01869>>19755000
                  genmsg(setno,fwriteerror,0,@save'fname,      <<01869>>19760000
                         @procname,,,,0);                      <<01869>>19765000
                  genmsg(setno,nologrec,0,@save'fname,         <<01869>>19770000
                         @procname,,,,0);                      <<01869>>19775000
                  notified := true;                            <<01869>>19780000
                  go nextone;                                  <<01869>>19785000
               end;                                            <<01869>>19790000
               if > then                                       <<01869>>19795000
               begin                                           <<01869>>19800000
                  fcheck(logfileno,errcode);                   <<01869>>19805000
                  genmsg(fssetno,errcode,,,,,,,0);             <<01869>>19810000
                  genmsg(setno,fwriteerror,0,@save'fname,      <<01869>>19815000
                         @procname,,,0);                       <<01869>>19820000
                  genmsg(setno,nologrec,0,@save'fname,         <<01869>>19825000
                         @procname,,,,0);                      <<01869>>19830000
                  notified := true;                            <<01869>>19835000
                  go nextone;                                  <<01869>>19840000
               end;                                            <<01869>>19845000
            end;                                                        19850000
         end until eoforerr or not valid;                               19855000
                                                               <<01869>>19860000
         fcontrol(logfileno,set'eof,parm);                     <<01869>>19865000
         if <> then                                            <<01869>>19870000
         begin                                                 <<01869>>19875000
            fcheck(logfileno,errcode);                         <<01869>>19880000
            genmsg(fssetno,errcode,,,,,,,0);                   <<01869>>19885000
            genmsg(setno,fwriteerror,0,@save'fname,@procname,  <<01869>>19890000
                   ,,,0);                                      <<01869>>19895000
            genmsg(setno,nologrec,0,@save'fname,@procname,     <<01869>>19900000
                   ,,,0);                                      <<01869>>19905000
            notified := true;                                  <<01869>>19910000
            go nextone;                                        <<01869>>19915000
         end;                                                  <<01869>>19920000
                                                               <<01869>>19925000
         len:=dascii(numrecovered,10,output1);                          19930000
         output1(len):=0;                                               19935000
         len:=ascii(numopen,10,output2);                                19940000
         output2(len):=0;                                               19945000
         len:=ascii(numclose,10,output3);                               19950000
         output3(len):=0;                                               19955000
         genmsg(setno,logrec,0,@output1,@procname,@output2,    <<01869>>19960000
                @output3);                                     <<01869>>19965000
         end          << disc logging recovery >>              <<01869>>19970000
      else                                                              19975000
      begin                                                             19980000
         <<tape logging>>                                               19985000
         case logging'type of                                  <<01869>>19990000
         begin                                                 <<01869>>19995000
            <<0>>  ;         << disc - never get here >>       <<01869>>20000000
            <<1>>  move dev := "TAPE ";                        <<01869>>20005000
            <<2>>  move dev := "SDISC ";                       <<01869>>20010000
            <<3>>  move dev := "CTAPE ";                       <<01869>>20015000
         end;                                                  <<01869>>20020000
                                                               <<01869>>20025000
         move forms:=".,,,,; ";                                         20030000
                                                               <<01869>>20035000
         << log file: old perm or temp, fixed, ascii, exc,  >> <<01869>>20040000
         << read/write, multi-rec, no buf, labeled tape.    >> <<01869>>20045000
                                                               <<01869>>20050000
         logfileno:=fopen(recov'fname,%3007,%524,recsize,dev,  <<01869>>20055000
                          forms,,blkfactor);                   <<01869>>20060000
         if <> then                                                     20065000
         begin                                                          20070000
            fcheck(logfileno,errcode);                         <<01869>>20075000
            genmsg(fssetno,errcode,,,,,,,0);                   <<01869>>20080000
            genmsg(setno,topenfailed,0,@save'fname,@procname,  <<01869>>20085000
                   ,,,0);                                      <<01869>>20090000
            genmsg(setno,nologrec,0,@save'fname,@procname,     <<01869>>20095000
                   ,,,0);                                      <<01869>>20100000
            notified := true;                                  <<01869>>20105000
            go nextone;                                        <<01869>>20110000
         end;                                                           20115000
                                                               <<01869>>20120000
         move dev:="DISC ";                                             20125000
                                                               <<01869>>20130000
         << buffer file: old perm, fixed, ascii, no :file,   >><<01869>>20135000
         << read/write, multi-rec, no buf, exc.              >><<01869>>20140000
                                                               <<01869>>20145000
         move bufname(8) := ".PUB.SYS ";                       <<01869>>20150000
         bufname (16) := 0;                                    <<01869>>20155000
         buffileno:=fopen(bufname,%2005,%524,recsize,dev);     <<01869>>20160000
         if <> then                                                     20165000
         begin                                                          20170000
            fcheck(buffileno,errcode);                         <<01869>>20175000
            genmsg(fssetno,errcode,,,,,,,0);                   <<01869>>20180000
            genmsg(setno,bopenfailed,0,@bufname,@procname,     <<01869>>20185000
                   ,,,0);                                      <<01869>>20190000
            genmsg(setno,nologrec,0,@save'fname,@procname,     <<01869>>20195000
                   ,,,0);                                      <<01869>>20200000
                                                                        20205000
            <<error opening buffer>>                                    20210000
                                                                        20215000
            notified := true;                                  <<01869>>20220000
            go nextone;                                        <<01869>>20225000
         end;                                                           20230000
         fgetinfo(buffileno,,,,,,,,,,eof);                              20235000
         if <> then                                            <<01869>>20240000
         begin                                                 <<01869>>20245000
            fcheck(buffileno,errcode);                         <<01869>>20250000
            genmsg(fssetno,errcode,,,,,,,0);                   <<01869>>20255000
            genmsg(setno,logrecerr,0,@bufname,@procname,,,,0); <<01869>>20260000
            genmsg(setno,nologrec,0,@save'fname,@procname,     <<01869>>20265000
                   ,,,0);                                      <<01869>>20270000
            notified := true;                                  <<01869>>20275000
            go nextone;                                        <<01869>>20280000
         end;                                                  <<01869>>20285000
         fgetinfo(logfileno,,,,,,tapedev);                     <<01869>>20290000
         if <> then                                            <<01869>>20295000
         begin                                                 <<01869>>20300000
            fcheck(logfileno,errcode);                         <<01869>>20305000
            genmsg(fssetno,errcode,,,,,,,0);                   <<01869>>20310000
            genmsg(setno,logrecerr,0,@save'fname,@procname,    <<01869>>20315000
                   ,,,0);                                      <<01869>>20320000
            genmsg(setno,nologrec,0,@save'fname,@procname,     <<01869>>20325000
                   ,,,0);                                      <<01869>>20330000
            notified := true;                                  <<01869>>20335000
            go nextone;                                        <<01869>>20340000
         end;                                                  <<01869>>20345000
                                                               <<01869>>20350000
         do                                                             20355000
         begin                                                          20360000
           <<main loop - tape logging>>                        <<01869>>20365000
            fread(logfileno,buffarea,blksize);                          20370000
            if <> then eoforerr:=true;                                  20375000
            @inrec:=@buffarea;                                          20380000
            @dinrec:=@buffarea;                                         20385000
            checkblock;                                                 20390000
            if valid then                                               20395000
            begin                                                       20400000
               @inrec:=@inrec-recsize;                         <<01869>>20405000
               @dinrec:=@inrec;                                         20410000
               lastrec:=dinrec(rnum);                                   20415000
            end                                                         20420000
            else                                                        20425000
            begin                                                       20430000
              <<bad block from tape>>                          <<01869>>20435000
               if first then                                   <<01869>>20440000
               begin                                                    20445000
                  << tape file empty -- set flag to get out >> <<01869>>20450000
                  eoforerr := true;                            <<01869>>20455000
                                                               <<01869>>20460000
                  << backspace to start of data >>             <<01869>>20465000
                                                               <<01869>>20470000
                  stat:=attachio(tapedev,qmisc,0,@buffarea,    <<01869>>20475000
                                 bkspace,0,0,0,flags);         <<01869>>20480000
                  if stat0.(13:3) <> success  and              <<01869>>20485000
                     stat0.(8:8) <> feof           then        <<01869>>20490000
                  begin    << error, but not eof >>            <<01869>>20495000
                     errcode := iostat(stat0);                 <<01869>>20500000
                     genmsg(fssetno,errcode,,,,,,,0);          <<01869>>20505000
                     genmsg(setno,fwriteerror,0,@save'fname,   <<01869>>20510000
                            @procname,,,,0);                   <<01869>>20515000
                     genmsg(setno,nologrec,0,@save'fname,      <<01869>>20520000
                            @procname,,,,0);                   <<01869>>20525000
                     notified := true;                         <<01869>>20530000
                     go nextone;                               <<01869>>20535000
                  end;                                         <<01869>>20540000
               end    <<empty file>>                           <<01869>>20545000
               else                                                     20550000
               begin                                                    20555000
                  << found the bad block.  rewind to beginning><<01869>>20560000
                  << of data.                                 ><<01869>>20565000
                                                               <<01869>>20570000
                  << rewind back to load point.           >>   <<01869>>20575000
                                                               <<01869>>20580000
                  stat:=attachio(tapedev,0,0,0,rewind,0,0,0,   <<01869>>20585000
                                 flags);                       <<01869>>20590000
                  if stat0.(13:3) <> success then              <<01869>>20595000
                  begin                                        <<01869>>20600000
                     errcode := iostat(stat0);                 <<01869>>20605000
                     genmsg(fssetno,errcode,,,,,,,0);          <<01869>>20610000
                     genmsg(setno,logrecerr,0,@save'fname,     <<01869>>20615000
                            @procname,,,,0);                   <<01869>>20620000
                    genmsg(setno,nologrec,0,@save'fname,       <<01869>>20625000
                           @procname,,,,0);                    <<01869>>20630000
                     notified := true;                         <<01869>>20635000
                     go nextone;                               <<01869>>20640000
                  end;                                         <<01869>>20645000
                                                               <<01869>>20650000
                  << now skip over label stuff to the data >>  <<01869>>20655000
                                                               <<01869>>20660000
                  stat:=attachio(tapedev,0,0,0,forwrd,0,0,0,   <<01869>>20665000
                                 flags);                       <<01869>>20670000
                  if stat0.(13:3) <> success  and              <<01869>>20675000
                     stat0.(8:8) <> feof       then            <<01869>>20680000
                  begin                                        <<01869>>20685000
                     errcode := iostat(stat0);                 <<01869>>20690000
                     genmsg(fssetno,errcode,,,,,,,0);          <<01869>>20695000
                     genmsg(setno,logrecerr,0,@save'fname,     <<01869>>20700000
                            @procname,,,,0);                   <<01869>>20705000
                    genmsg(setno,nologrec,0,@save'fname,       <<01869>>20710000
                           @procname,,,,0);                    <<01869>>20715000
                     notified := true;                         <<01869>>20720000
                     go nextone;                               <<01869>>20725000
                  end;                                         <<01869>>20730000
                                                               <<01869>>20735000
                  << now find the last good block >>           <<01869>>20740000
                                                               <<01869>>20745000
                  stopper := (lastrec+1d) - double(blkfactor); <<01869>>20750000
                  if stopper < 1d  then stopper := 1d;         <<01869>>20755000
                                                               <<01869>>20760000
                  do                                           <<01869>>20765000
                   begin                                       <<01869>>20770000
                      len := fread(logfileno,buffarea,blksize);<<01869>>20775000
                      if  <>  or  len = 0  then                <<01869>>20780000
                      begin                                    <<01869>>20785000
                        fcheck(logfileno,errcode);             <<01869>>20790000
                        genmsg(fssetno,errcode,,,,,,,0);       <<01869>>20795000
                        genmsg(setno,logrecerr,0,@save'fname,  <<01869>>20800000
                               @procname,,,,0);                <<01869>>20805000
                        genmsg(setno,nologrec,0,@save'fname,   <<01869>>20810000
                               @procname,,,,0);                <<01869>>20815000
                        notified := true;                      <<01869>>20820000
                        go nextone;                            <<01869>>20825000
                      end;                                     <<01869>>20830000
                   end                                         <<01869>>20835000
                  until  dbuffarea(rnum) = stopper;            <<01869>>20840000
                                                               <<01869>>20845000
                  << set flag to get out >>                    <<01869>>20850000
                                                               <<01869>>20855000
                  eoforerr := true;                            <<01869>>20860000
               end;     << bad block from tape >>              <<01869>>20865000
           end;         << main loop - tape recovery >>        <<01869>>20870000
         end       << main loop - tape logging>>               <<01869>>20875000
        until not valid  or  eoforerr;                         <<01869>>20880000
                                                               <<01869>>20885000
         @inrec:=@discrec;                                              20890000
         @dinrec:=@inrec;                                               20895000
         recnum:=-1d;                                                   20900000
         eoforerr:=false;                                               20905000
         valid:=true;                                                   20910000
         do                                                             20915000
         begin                                                          20920000
            freaddir(buffileno,discrec,recsize,                <<01869>>20925000
                      (recnum:=recnum+1d));                    <<01869>>20930000
            if <> then eoforerr:=true;                                  20935000
            if first then lastrec := ddiscrec(rnum) - 1d;      <<01869>>20940000
         end until eoforerr or (ddiscrec(rnum)=lastrec+1d);             20945000
                                                               <<01869>>20950000
         if eoforerr then                                               20955000
         begin                                                          20960000
            if first then                                      <<01869>>20965000
            begin         << disc buffer and logfile empty >>  <<01869>>20970000
                          << nothing to recover.           >>  <<01869>>20975000
               genmsg(setno,logempty,0,@save'fname,@procname,  <<01869>>20980000
                      ,,,0);                                   <<01869>>20985000
               notified := true;                               <<01869>>20990000
               go nextone;                                     <<01869>>20995000
            end;                                               <<01869>>21000000
                                                               <<01869>>21005000
            currrec := lastrec;                                <<01869>>21010000
            formatcrash;                                                21015000
            fwrite(logfileno,buffarea,blksize,0);                       21020000
            if <> then                                         <<01869>>21025000
            begin                                              <<01869>>21030000
               fcheck(logfileno,errcode);                      <<01869>>21035000
               genmsg(fssetno,errcode,,,,,,,0);                <<01869>>21040000
               genmsg(setno,fwriteerror,0,@save'fname,         <<01869>>21045000
                      @procname,,,,0);                         <<01869>>21050000
               genmsg(setno,nologrec,0,@save'fname,@procname,  <<01869>>21055000
                      ,,,0);                                   <<01869>>21060000
               notified := true;                               <<01869>>21065000
               go nextone;                                     <<01869>>21070000
            end;                                               <<01869>>21075000
         end                                                            21080000
         else                                                           21085000
         begin                                                          21090000
            << when we get here, we have found the last good >><<01869>>21095000
            << block from the logfile and the first block    >><<01869>>21100000
            << needed from the buffer file. we need to update>><<01869>>21105000
            << currrec so that when we get ready to output   >><<01869>>21110000
            << where we left off, the log records will be in >><<01869>>21115000
            << sequence.                                     >><<01869>>21120000
                                                               <<01869>>21125000
            currrec := lastrec;                                <<01869>>21130000
                                                               <<01869>>21135000
            do                                                          21140000
            begin                                                       21145000
                                                               <<01869>>21150000
               freaddir(buffileno,buffarea,blksize,recnum);             21155000
               if <> then                                      <<01869>>21160000
               begin                                           <<01869>>21165000
                  fcheck(buffileno,errcode);                   <<01869>>21170000
                  genmsg(fssetno,errcode,,,,,,,0);             <<01869>>21175000
                  genmsg(setno,logrecerr,0,@save'fname,        <<01869>>21180000
                         @procname,,,,0);                      <<01869>>21185000
                  genmsg(setno,nologrec,0,@save'fname,         <<01869>>21190000
                         @procname,,,,0);                      <<01869>>21195000
                  notified := true;                            <<01869>>21200000
                  go nextone;                                  <<01869>>21205000
               end;                                            <<01869>>21210000
                                                               <<01869>>21215000
               @inrec:=@buffarea;                                       21220000
               @dinrec:=@buffarea;                                      21225000
               checkblock;                                              21230000
               if valid then                                            21235000
               begin                                                    21240000
                  fwrite(logfileno,buffarea,blksize,0);                 21245000
                  if <> then                                   <<01869>>21250000
                  begin                                        <<01869>>21255000
                   fcheck(logfileno,errcode);                  <<01869>>21260000
                   genmsg(fssetno,errcode,,,,,,,0);            <<01869>>21265000
                   genmsg(setno,fwriteerror,0,@save'fname,     <<01869>>21270000
                          @procname,,,,0);                     <<01869>>21275000
                   genmsg(setno,nologrec,0,@save'fname,        <<01869>>21280000
                          @procname,,,,0);                     <<01869>>21285000
                   notified := true;                           <<01869>>21290000
                   go nextone;                                 <<01869>>21295000
                  end;                                         <<01869>>21300000
                  recnum:=recnum+double(blkfactor);                     21305000
                  if recnum >= eof then recnum:=0d;                     21310000
                                                               <<01869>>21315000
                  << bump lastrec to remember the last     >>  <<01869>>21320000
                  << record successfully recovered.        >>  <<01869>>21325000
                                                               <<01869>>21330000
                  lastrec := lastrec + double(blkfactor);      <<01869>>21335000
               end                                                      21340000
               else                                                     21345000
               begin                                                    21350000
                  << need to bump currrec to reflect the     >><<01869>>21355000
                  << current # of good records found. lastrec>><<01869>>21360000
                  << is the # actuallly written to the       >><<01869>>21365000
                  << logfile, i is the number of good records>><<01869>>21370000
                  << found in the last block from the buffer >><<01869>>21375000
                  << file.                                   >><<01869>>21380000
                                                               <<01869>>21385000
                  currrec := lastrec + double(i);              <<01869>>21390000
                  formatcrash;                                          21395000
                                                               <<01869>>21400000
                  fwrite(logfileno,buffarea,blksize,0);                 21405000
                  if <> then                                   <<01869>>21410000
                  begin                                        <<01869>>21415000
                   fcheck(logfileno,errcode);                  <<01869>>21420000
                   genmsg(fssetno,errcode,,,,,,,0);            <<01869>>21425000
                   genmsg(setno,fwriteerror,0,@save'fname,     <<01869>>21430000
                          @procname,,,,0);                     <<01869>>21435000
                   genmsg(setno,nologrec,0,@save'fname,        <<01869>>21440000
                          @procname,,,,0);                     <<01869>>21445000
                   notified := true;                           <<01869>>21450000
                   go nextone;                                 <<01869>>21455000
                  end;                                         <<01869>>21460000
               end;                                                     21465000
            end until not valid or eoforerr;                            21470000
                                                               <<01869>>21475000
         end;                                                           21480000
         len:=dascii(numrecovered,10,output1);                          21485000
         output1(len):=0;                                               21490000
         len:=ascii(numopen,10,output2);                                21495000
         output2(len):=0;                                               21500000
         len:=ascii(numclose,10,output3);                               21505000
         output3(len):=0;                                               21510000
         genmsg(setno,logrec,0,@output1,@procname,@output2,    <<01869>>21515000
                @output3);                                     <<01869>>21520000
      end;         <<tape logging>>                            <<01869>>21525000
                                                               <<01869>>21530000
      nextone:                                                          21535000
                                                               <<01869>>21540000
      relentry(tabindex,0);                                             21545000
      fclose(logfileno,0,0);                                            21550000
      if <> and (not notified) then                            <<01869>>21555000
      begin                                                    <<01869>>21560000
         fcheck(logfileno,errcode);                            <<01869>>21565000
         genmsg(fssetno,errcode,,,,,,,0);                      <<01869>>21570000
         genmsg(setno,logrecerr,0,@save'fname,@procname,,,,0); <<01869>>21575000
         genmsg(setno,nologrec,0,@save'fname,@procname,,,,0);  <<01869>>21580000
      end;                                                     <<01869>>21585000
      fclose(buffileno,4,0);                                            21590000
      exchangedb(logdst);                                               21595000
   end             <<recover loop>>                            <<01869>>21600000
  until (tabindex:=next'tabindex) = null;                      <<01869>>21605000
   out:                                                                 21610000
                                                               <<01869>>21615000
   exchangedb(0);    << back to stack >>                                21620000
   <<logging process recovered>>                                        21625000
end;                                                                    21630000
$page "INITRECLOG -- Set up warmstart recovery"                         21635000
procedure initreclog;                                                   21640000
option privileged,uncallable;                                           21645000
begin                                                                   21650000
                                                                        21655000
comment                                                        <<01869>>21660000
  called from progen to initiate reclog (to recover open       <<01869>>21665000
  logging files). the logging files will only be recovered     <<01869>>21670000
  during a warmstart since any other start will re-initialize  <<01869>>21675000
  the logtab (dst %33) such that there are no current logging  <<01869>>21680000
  processes.                                                   <<01869>>21685000
;                                                              <<01869>>21690000
                                                               <<01869>>21695000
                                                               <<01869>>21700000
   integer cleanupin:=0,stack,db;                                       21705000
   logical nostdin:=0, nostdlist:=0;     << for procreate >>   <<01869>>21710000
   equate nostring=0, nostlen=0;                               <<01869>>21715000
                                                               <<01869>>21720000
   stack:=getstack(initstack,maxstack);                                 21725000
   tos:=@cleanupin;                                                     21730000
   if stack <> 0 then                                                   21735000
   begin                                                                21740000
      tos:=a'(reclogplabel);                                            21745000
                                                               <<01869>>21750000
      << the external p-label is in the form:                >><<01869>>21755000
      << stt entry, code segment number. procreate only needs>><<01869>>21760000
      << the code segment number.                            >><<01869>>21765000
                                                               <<01869>>21770000
      tos.(0:8):=0;                                                     21775000
      tos.(0:1):=1;                                                     21780000
                                                               <<01869>>21785000
      << also need the delta p-label - starting offset within>><<01869>>21790000
      << the code segment for the procedure.                 >><<01869>>21795000
                                                               <<01869>>21800000
      tos:=a'(reclogdeltap);                                            21805000
      procreate(*,*,*,stack,globsize,0,locsize,pri,nostring,   <<01869>>21810000
                nostlen,0,%713,maxstack,nostdin,nostdlist);    <<01869>>21815000
      if = then                                                         21820000
      begin            << procreate was successfull >>         <<01869>>21825000
      db:=exchangedb(stack);                                            21830000
                                                               <<01869>>21835000
      << set up the primary db area of the stack. the only   >><<01869>>21840000
      << global variables used by reclog are buffarea and    >><<01869>>21845000
      << discrec - need to set up their pointers.            >><<01869>>21850000
                                                               <<01869>>21855000
      pdb(5) := %71;           << word addr for buffarea     >><<01869>>21860000
      pdb(6) := %10071;        << word addr for discrec      >><<01869>>21865000
                                                               <<01869>>21870000
      tos:=exchangedb(db);                                              21875000
      awake(cleanupin*pcbsize,%1,0);                                    21880000
      end;                                                     <<01869>>21905000
                                                               <<01869>>21910000
   end;                                                                 21915000
end;                                                                    21920000
$page "CLEANUP -- release user entries from LOGBUFF"                    21925000
procedure cleanuplog;                                                   21930000
option privileged,uncallable;                                           21935000
begin                                                                   21940000
                                                                        21945000
                                                                        21950000
<<user logging process termination cleanup>>                            21955000
                                                                        21960000
                                                                        21965000
   logical pointer pxfixed;                                             21970000
   logical pointer s0 = s-0;                                            21975000
   integer db,db2;                                                      21980000
   integer saveindex;                                          <<01869>>21985000
   integer index,tabindex;                                              21990000
   logical a;                                                           21995000
                                                               <<01869>>22000000
                                                               <<01869>>22005000
   db:=exchangedb(0);                                                   22010000
   push(dl);                                                            22015000
   assemble(dup);                                                       22020000
   tos:=tos-2;                                                          22025000
   tos:=s0;                                                             22030000
   assemble(xch,del,sub);                                               22035000
   @pxfixed:=tos;                                                       22040000
   if pxfxlogging = 1 then                                     <<01869>>22045000
   begin                                                                22050000
      pxfxlogging:=0;                                          <<01869>>22055000
      exchangedb(logdst);                                      <<01869>>22060000
      a:=getsir(logsir);                                       <<01869>>22065000
      tabindex:=logtab(inuse);                                          22070000
      if tabindex = null then                                           22075000
      begin                                                             22080000
         relsir(logsir,a);                                     <<01869>>22085000
         exchangedb(db);                                       <<01869>>22090000
         return;                                                        22095000
      end;                                                              22100000
                                                               <<01869>>22105000
      do                                                                22110000
      begin                                                             22115000
                                                                        22120000
         db2 := logtab(dst);                                   <<01869>>22125000
         if logtab(status) = initializing  or                  <<01869>>22130000
            logtab(status) = recovering then go around;        <<01869>>22135000
         if db2 = null then go around;                         <<01869>>22140000
         exchangedb(logtab(dst));                              <<01869>>22145000
         obtain(dlogbuff(resource),null);                      <<01869>>22150000
         index:=logbuff(uhead);                                         22155000
                                                               <<01869>>22160000
         if index <> null then                                          22165000
         do                                                             22170000
         begin                                                          22175000
            if logbuff(upin) = mypin  then                     <<01869>>22180000
            begin                                              <<01869>>22185000
               saveindex:=logbuff(nentry);                     <<01869>>22190000
               relentry(index,db2);                            <<01869>>22195000
               index:=saveindex;                               <<01869>>22200000
            end                                                <<01869>>22205000
            else index:=logbuff(nentry);                       <<01869>>22210000
                                                                        22215000
         end until index = null;                               <<01869>>22220000
         release(dlogbuff(resource),null,1);                   <<01869>>22225000
         if logbuff(numuser) = 0 then                                   22230000
         awake(logbuff(logpin),%20,0);                                  22235000
around:                                                        <<01869>>22260000
                                                                        22265000
                                                               <<01869>>22270000
         exchangedb(logdst);                                   <<01869>>22275000
      end until (tabindex:=logtab(next)) = null;                        22280000
      relsir(logsir,a);                                                 22285000
      exchangedb(db);                                          <<01869>>22290000
   end;                                                                 22295000
end;                                                                    22300000
$page "Table Access Utilities -- RELENTRY"                              22305000
procedure relentry(index',type);                               <<01869>>22310000
value index',type;                                                      22315000
integer index',type;                                                    22320000
option privileged,uncallable;                                           22325000
begin                                                                   22330000
                                                                        22335000
                                                                        22340000
   <<this procedure releases logging entries in the global       >>     22345000
   <<logging table logtab and in the communication area of logbuf>>     22350000
   <<to specify the global table, type must be zero.  to specify >>     22355000
   <<an entry in logbuff, type must be set to the dst number of  >>     22360000
   <<logbuff                                                     >>     22365000
   <<                                                            >>     22370000
   <<the address for the  entry to be deleted should be in the   >>     22375000
   <<index parameter.                                            >>     22380000
   <<                                                            >>     22385000
   << split stack calls are not permitted by this procedure      >>     22390000
                                                                        22395000
                                                                        22400000
                                                                        22405000
   integer x = x;                                                       22410000
   logical s0 = s-0;                                           <<01869>>22415000
   logical already'locked;                                     <<01869>>22420000
   integer prev',                                                       22425000
   next',                                                               22430000
   freeentry;                                                           22435000
                                                                        22440000
   logical a;                                                           22445000
   integer tabindex,index,db;                                           22450000
   logical cond;                                                        22455000
                                                               <<01869>>22460000
                                                               <<01869>>22465000
   if type = 0 then                                                     22470000
   begin                                                                22475000
      tabindex:=index';                                                 22480000
      a:=getsir(logsir);                                                22485000
      db:=exchangedb(logdst);                                           22490000
      <<globl logtab>>                                                  22495000
      prev':=logtab(prev);                                              22500000
      next':=logtab(next);                                              22505000
      freeentry:=tabindex;                                              22510000
      x:=freeentry;                                            <<01869>>22515000
      do                                                       <<01869>>22520000
      logtab(x) := "  "                                        <<01869>>22525000
      until (x:=x+1) >= (freeentry+tentrysize-2);              <<01869>>22530000
      logtab(next):=logtab(free);                                       22535000
      logtab(prev):=null;                                               22540000
      logtab(lgswitch) := false;                               <<01869>>22545000
      logtab(dst) := null;                                     <<01869>>22550000
                                                               <<01869>>22555000
      tabindex:=logtab(free);                                           22560000
      logtab(prev):=freeentry;                                          22565000
      logtab(free):=freeentry;                                          22570000
                                                                        22575000
      <<now remove from in use>>                                        22580000
                                                                        22585000
      if prev' <> null then                                             22590000
      begin                                                             22595000
         tabindex:=prev';                                               22600000
         logtab(next):=next';                                           22605000
      end;                                                              22610000
      if next' <> null then                                             22615000
      begin                                                             22620000
         tabindex:=next';                                               22625000
         logtab(prev):=prev';                                           22630000
      end;                                                              22635000
      if prev' = null then logtab(inuse):=next';                        22640000
      relsir(logsir,a);                                                 22645000
      db:=exchangedb(db);                                               22650000
   end                                                                  22655000
   else                                                                 22660000
   begin                                                                22665000
      index:=index';                                                    22670000
      cond:=true;                                                       22675000
      db:=exchangedb(type);                                             22680000
if logbuff(res2'owner) = mypin then                            <<01869>>22685000
         already'locked := true                                <<01869>>22690000
      else                                                     <<01869>>22695000
      begin                                                    <<01869>>22700000
         already'locked := false;                              <<01869>>22705000
         obtain(dlogbuff(resource2),null);                     <<01869>>22710000
      end;                                                     <<01869>>22715000
      prev':=logbuff(pentry);                                           22720000
      next':=logbuff(nentry);                                           22725000
      freeentry:=index;                                                 22730000
      x:=freeentry;                                                     22735000
      do                                                                22740000
      logbuff(x) := "  "                                       <<01869>>22745000
      until (x:=x+1) >= (freeentry+bentrysize-2);              <<01869>>22750000
      logbuff(nentry):=logbuff(fhead);                                  22755000
      logbuff(pentry):=null;                                            22760000
      index:=logbuff(fhead);                                            22765000
      if index <> null then logbuff(pentry):=freeentry;                 22770000
      logbuff(fhead):=freeentry;                                        22775000
                                                                        22780000
      <<now remove from in use>>                                        22785000
                                                                        22790000
      if prev' <> null then                                             22795000
      begin                                                             22800000
         index:=prev';                                                  22805000
         logbuff(nentry):=next';                                        22810000
      end;                                                              22815000
      if next' <> null then                                             22820000
      begin                                                             22825000
         index:=next';                                                  22830000
         logbuff(pentry):=prev';                                        22835000
      end;                                                              22840000
      if prev' = null then logbuff(uhead):=next';                       22845000
      logbuff(numuser):=logbuff(numuser)-1;                             22850000
      if not already'locked then                               <<01869>>22855000
         release(dlogbuff(resource2),null,1);                  <<01869>>22860000
      db:=exchangedb(db);                                               22885000
   end;                                                                 22890000
   writedseg(logdst);                                                   22895000
end;                                                                    22900000
$page "Table Access Utilities -- GENTRY"                       <<01869>>22905000
logical procedure gentry(index',type);                                  22910000
value type;                                                             22915000
integer index',type;                                                    22920000
option privileged,uncallable;                                           22925000
begin                                                                   22930000
                                                                        22935000
                                                                        22940000
   <<this procedure gets a logging entry in the system global loggin>>  22945000
   <<datasegment logtab or in the logging process comm area of logbu>>  22950000
   <<if an entry is desired in the logtab, type must be set to zero >>  22955000
   <<if an entry is desired in logbuff, type must be set to the dst >>  22960000
   <<number of logbuff.                                             >>  22965000
   <<                                                               >>  22970000
   <<split stack calls are not permitted by this procedure          >>  22975000
   <<                                                               >>  22980000
   <<the relative address where the aquired entry resides is returne>>  22985000
   <<in the index parameter.                                        >>  22990000
   <<                                                        >><<01869>>22995000
   << returns:                                           >>    <<01869>>23000000
   <<     true - entry obtained from table.              >>    <<01869>>23005000
   <<     false- no more entries available.              >>    <<01869>>23010000
                                                                        23015000
                                                                        23020000
   logical a;                                                           23025000
   integer db;                                                          23030000
   logical already'locked;                                     <<01869>>23035000
   integer                                                              23040000
   newentry,                                                            23045000
   qindex;                                                              23050000
   integer tabindex,index;                                              23055000
   logical s0 = s-0;                                                    23060000
                                                                        23065000
   if type = 0  then   <<entry in logtab>>                     <<01869>>23070000
   begin                                                                23075000
      << globl logging table >>                                         23080000
      a:=getsir(logsir);                                                23085000
      db:=exchangedb(logdst);                                           23090000
      tabindex:=logtab(free);                                           23095000
      if tabindex = null then                                           23100000
      begin                                <<no more entries>>          23105000
         gentry:=false;                                                 23110000
         relsir(logsir,a);                                              23115000
         exchangedb(db);                                       <<01869>>23120000
         return;                                                        23125000
      end;                                                              23130000
      newentry:=logtab(free);                                           23135000
      <<remove from free list>>                                         23140000
                                                                        23145000
      logtab(free):=logtab(next);                                       23150000
      tabindex:=logtab(free);                                  <<01869>>23155000
      logtab(prev):=null;                                               23160000
                                                               <<01869>>23165000
      <<add to inuse list>>                                             23170000
                                                               <<01869>>23175000
      tabindex:= if logtab(inuse) = null then                           23180000
      newentry else logtab(inuse);                                      23185000
      logtab(prev):= if logtab(inuse) =null then                        23190000
      null else newentry;                                               23195000
                                                               <<01869>>23200000
      tabindex:=newentry;                                               23205000
                                                               <<01869>>23210000
      << clear the entry -- except the prev and next ptrs >>   <<01869>>23215000
                                                               <<01869>>23220000
      logtab(tabindex) := "  ";                                <<01869>>23225000
      move logtab(tabindex+1) := logtab(tabindex),             <<01869>>23230000
           (tentrysize-3);                                     <<01869>>23235000
                                                               <<01869>>23240000
      logtab(lgswitch) := false;                               <<01869>>23245000
      logtab(dst) := null;                                     <<01869>>23250000
      logtab(next):=logtab(inuse);                                      23255000
      logtab(inuse):=newentry;                                          23260000
                                                               <<01869>>23265000
      <<update globl entries>>                                          23270000
      logtab(numentries):=logtab(numentries)+1;                         23275000
      relsir(logsir,a);                                                 23280000
      gentry:=true;                                                     23285000
      db:=exchangedb(db);                                               23290000
      index':=newentry;                                                 23295000
   end                                                                  23300000
   else                                                                 23305000
   begin                                                                23310000
      <<entry in logbuff; type = buffer dst>>                  <<01869>>23315000
      db:=exchangedb(type);                                             23320000
if logbuff(res2'owner) = mypin then                            <<01869>>23325000
         already'locked := true                                <<01869>>23330000
      else                                                     <<01869>>23335000
      begin                                                             23340000
         already'locked := false;                              <<01869>>23345000
         obtain(dlogbuff(resource2),null);                     <<01869>>23350000
      end;                                                              23355000
      index:=logbuff(fhead);                                            23360000
      if index = null then                                              23365000
      begin                                <<no more entries>>          23370000
         if not already'locked then                            <<01869>>23375000
            release(dlogbuff(resource2),null,1);               <<01869>>23380000
         db:=exchangedb(db);                                            23405000
         gentry:=false;                                                 23410000
         return;                                                        23415000
      end;                                                              23420000
      logbuff(wstate):=act;  <<to prevent wakeup>>                      23425000
      qindex:=index;                                                    23430000
      newentry:=logbuff(fhead);                                         23435000
                                                               <<01869>>23440000
      <<remove from free list>>                                         23445000
      logbuff(fhead):=logbuff(nentry);                                  23450000
      qindex:=logbuff(fhead);                                           23455000
      logbuff(pentry):=null;                                            23460000
                                                               <<01869>>23465000
      <<add to inuse list>>                                             23470000
      index:= if logbuff(uhead) = null then                             23475000
      newentry else logbuff(uhead);                                     23480000
      logbuff(pentry):= if logbuff(uhead)=null then                     23485000
      null else newentry;                                               23490000
      index:=newentry;                                                  23495000
      logbuff(nentry):=logbuff(uhead);                                  23500000
      logbuff(uhead):=newentry;                                         23505000
      <<update globl entries>>                                          23510000
                                                                        23515000
      logbuff(numuser):=logbuff(numuser)+1;                             23520000
      if not already'locked then                               <<01869>>23525000
         release(dlogbuff(resource2),null,1);                  <<01869>>23530000
      db:=exchangedb(db);                                               23555000
      gentry:=true;                                                     23560000
      index':=newentry;                                                 23565000
   end;                                                                 23570000
   writedseg(logdst);                                                   23575000
end;                                                                    23580000
$page "Table Access Utilities -- FINDLOG"                      <<01869>>23585000
logical procedure findlog(logname,index');                              23590000
integer index';                                                         23595000
byte array logname;                                                     23600000
option privileged,uncallable;                                           23605000
begin                                                                   23610000
                                                                        23615000
                                                                        23620000
   <<this procedure finds the entry specified by logname in the  >>     23625000
   <<master logging dst.   the index into the dst where the entry>>     23630000
   <<resides is returned in the index parameter.                 >>     23635000
   <<                                                            >>     23640000
   <<                                                            >>     23645000
   <<split stack calls are not permitted by this procedure       >>     23650000
                                                                        23655000
                                                                        23660000
   logical a;                                                           23665000
   logical array entry'(0:tentrysize-1) = q;                   <<01869>>23670000
   byte array bentry'(*)=entry';                                        23675000
   integer tabindex,j,k;                                       <<01869>>23680000
                                                               <<01869>>23685000
                                                               <<01869>>23690000
   tabindex:=0;                                                         23695000
   findlog:=true;                                                       23700000
   a:=getsir(logsir);                                                   23705000
   move'from'dseg(@entry',logdst,inuse,1);                     <<01869>>23710000
   if entry' = null then                                                23715000
   begin                                                                23720000
      <<empty dst>>                                                     23725000
      relsir(logsir,a);                                                 23730000
      findlog:=false;                                                   23735000
      return;                                                           23740000
   end;                                                                 23745000
   entry'(next):=entry';                                                23750000
   move logname:=logname while an,0;                                    23755000
   k:=tos-@logname;                                                     23760000
   do                                                                   23765000
   begin                                                                23770000
      if entry'(next) = null then                                       23775000
      begin                                                             23780000
         findlog:=false;                                                23785000
         relsir(logsir,a);                                              23790000
         return;                                                        23795000
      end;                                                              23800000
      index' := entry'(next);                                  <<01869>>23805000
      move'from'dseg(@entry',logdst,entry'(next),tentrysize);  <<01869>>23810000
      if bentry'(7) <> " " then j:=8                                    23815000
      else                                                              23820000
      begin                                                             23825000
         move bentry':=bentry' while an,0;                              23830000
         j:=tos-@bentry';                                               23835000
      end;                                                              23840000
   end                                                         <<01869>>23845000
  until  (bentry'=logname, (j)) and (j=k);                     <<01869>>23850000
                                                               <<01869>>23855000
  if entry'(dst) = null and (entry'(status) = act  lor         <<01869>>23860000
                             entry'(status) = inact)           <<01869>>23865000
    then findlog := false;                                     <<01869>>23870000
                                                               <<01869>>23875000
   relsir(logsir,a);                                                    23880000
end;                                                                    23885000
$page "INITLOG -- Log Process Initialization"                           23890000
logical procedure initlog(logname,target);                              23895000
value target;                                                           23900000
integer target;                                                         23905000
byte array logname;                                                     23910000
option privileged,uncallable;                                           23915000
begin                                                                   23920000
                                                                        23925000
comment                                                        <<01869>>23930000
                                                               <<01869>>23935000
  called from cxlog (mod. 85) when need to start or restart a  <<01869>>23940000
  logging process. will create the logging process (named      <<01869>>23945000
  logname) and have it adopted by progen (this system process  <<01869>>23950000
  will run in the linear queue). target is used to specify     <<01869>>23955000
  whether a start or restart was specified.                    <<01869>>23960000
  target.(0:8) = 5  for resstart                               <<01869>>23965000
  target.(0:8) = 0  for start                                  <<01869>>23970000
                                                               <<01869>>23975000
  note:                                                        <<01869>>23980000
    db must be at stack.                                       <<01869>>23985000
;                                                              <<01869>>23990000
                                                                        23995000
                                                                        24000000
                                                                        24005000
   integer ulogpin:= 0,logproc'stack;                                   24010000
   logical a;                                                  <<01869>>24015000
   integer i;                                                           24020000
   logical lid'type;                                           <<01869>>24025000
   logical pri;                                                         24030000
   byte array fname(0:36) = q;                                 <<01869>>24035000
   byte pointer bps0 = s-0;                                    <<01869>>24040000
   logical array entry'(0:tentrysize-1) = q;                   <<01869>>24045000
   byte array bentry'(*)=entry';                                        24050000
   integer tabindex,index;                                              24055000
   logical nostdin:=0, nostdlist:=0;     << for procreate >>   <<01869>>24060000
   equate nostring=0, nostlen=0;                               <<01869>>24065000
                                                               <<01869>>24070000
                                                               <<01869>>24075000
   tabindex:=0;                                                         24080000
   a := getsir(logsir);                                        <<01869>>24085000
   if not gentry(index,0) then                                 <<01869>>24090000
      begin  << couldn't get an entry in the log dst >>        <<01869>>24095000
      relsir(logsir,a);                                        <<01869>>24100000
      initlog := false;                                        <<01869>>24105000
      return;                                                  <<01869>>24110000
      end    << couldn't get entry >>                          <<01869>>24115000
   else                                                        <<01869>>24120000
   begin                                       <<got a space>>          24125000
      fname := " ";                                            <<01869>>24130000
      move fname(1) := fname, (36);                            <<01869>>24135000
                                                               <<01869>>24140000
      move'from'dseg(@entry',logdst,index,tentrysize);         <<01869>>24145000
      move bentry':=logname,(8);                                        24150000
      entry'(numusers) := 0;                                   <<01869>>24155000
      fentry(bentry'(lgname),,fname,,,lid'type);               <<01869>>24160000
      if > then                                                         24165000
      begin                                                             24170000
         relentry(index,0);                                             24175000
         relsir(logsir,a);                                     <<01869>>24180000
         initlog:=false;                                                24185000
         return;                                                        24190000
      end;                                                              24195000
      entry'(lgtype) := lid'type.typ'current;                  <<01869>>24200000
      entry'(lgauto) := lid'type.typ'allow'auto;               <<01869>>24205000
      move bentry'(lfname) := fname while an, 0;               <<01869>>24210000
      if bps0 = "/" then                                       <<01869>>24215000
      begin                                                    <<01869>>24220000
         @bps0 := @bps0 + 1;                                   <<01869>>24225000
         move bentry'(lflockw) := bps0 while an, 0;            <<01869>>24230000
      end;                                                     <<01869>>24235000
      if bps0 = "." then                                       <<01869>>24240000
      begin                                                    <<01869>>24245000
         @bps0 := @bps0 + 1;                                   <<01869>>24250000
         move bentry'(lfgroup) := bps0 while an, 0;            <<01869>>24255000
         if bps0 = "."  then                                   <<01869>>24260000
         begin                                                 <<01869>>24265000
            @bps0 := @bps0 + 1;                                <<01869>>24270000
            move bentry'(lfacct) := bps0 while an;             <<01869>>24275000
         end;                                                  <<01869>>24280000
      end;                                                     <<01869>>24285000
                                                               <<01869>>24290000
      pri:=[5/4,3/0,8/149];                                             24295000
      logproc'stack:=getstack(initstack,maxstack);                      24300000
      tos:=@ulogpin;                                                    24305000
      if logproc'stack <> 0 then                                        24310000
      begin                                                             24315000
         if target.(0:8) = restrt then                                  24320000
         tos := a'(ulogrstartplabel)                           <<01869>>24325000
         else tos:=a'(ulogplabel);                                      24330000
         << zero out the stt entry of the external p-label >>  <<01869>>24335000
         << procreate only needs the code segment number.  >>  <<01869>>24340000
                                                               <<01869>>24345000
         tos.(0:8):=0;                                                  24350000
         tos.(0:1):=1;                                                  24355000
                                                               <<01869>>24360000
         << also need the delta p-label  -  offset within the>><<01869>>24365000
         << code segment where the procedure begins.         >><<01869>>24370000
                                                               <<01869>>24375000
         if target.(0:8) = restrt                              <<01869>>24380000
          then tos:=a'(ulogrstartdeltap)                       <<01869>>24385000
         else tos:=a'(ulogdeltap);                                      24390000
         procreate(*,*,*,logproc'stack,globsize,0,locsize,pri, <<01869>>24395000
                   nostring,nostlen,index,%13,maxstack,        <<01869>>24400000
                   nostdin,nostdlist);                         <<01869>>24405000
         if = then                                                      24410000
         begin                                                          24415000
            <<make process a system process (son of progen)>>  <<01869>>24420000
            adopt(ulogpin,3);                        <<00601>> <<01869>>24425000
            exchangedb(logproc'stack);                                  24430000
            pdb(0):=0;                                                  24435000
            i:=0;                                                       24440000
            do begin pdb(i+1):=pdb(i) end until (i:=i+1) >=255;         24445000
                                                               <<01869>>24450000
            << set up the stack.  >>                           <<01869>>24455000
                                                               <<01869>>24460000
            << first primary db >>                             <<01869>>24465000
                                                               <<01869>>24470000
            pdb(0) := %16;      << byte addr for zeros       >><<01869>>24475000
            pdb(1) := %22;      << byte addr for forms       >><<01869>>24480000
            pdb(2) := %34;      << byte addr for fname       >><<01869>>24485000
            pdb(3) := %102;    << byte addr for bfname       >><<01869>>24490000
            pdb(4) := %150;    << byte addr for prcname      >><<01869>>24495000
            pdb(5) := %71;     << word addr for buffarea     >><<01869>>24500000
            pdb(6) := %10071;  << word addr for discrec      >><<01869>>24505000
                                                               <<01869>>24510000
            << now set up secondary db >>                      <<01869>>24515000
                                                               <<01869>>24520000
            pdb(7) := "00";     << initialize the zeros      >><<01869>>24525000
            pdb(8) := "00";     <<     array for later use   >><<01869>>24530000
            exchangedb(0);                                              24535000
         end                                                            24540000
         else                                                           24545000
         begin                                                          24550000
            relentry(index,0);                                          24555000
            relsir(logsir,a);                                  <<01869>>24560000
            initlog:=false;                                             24565000
            return;                                                     24570000
         end;                                                           24575000
         <<now add entry to logging table>>                             24580000
                                                               <<01869>>24585000
                                                               <<01869>>24590000
         move bentry'(bname):="ULOG    ";                      <<01869>>24595000
                                                               <<01869>>24600000
         entry'(pin) := ulogpin * pcbsize;                     <<01869>>24605000
         entry'(status) := initializing;                       <<01869>>24610000
         entry'(lgswitch) := false;                            <<01869>>24615000
         entry'(lgnewtype) := null;                            <<01869>>24620000
                                                               <<01869>>24625000
         entry'(lgnewauto) := false;                           <<01869>>24630000
         move'to'dseg(logdst,index,@entry',tentrysize-2);      <<01869>>24635000
         writedseg(logdst);                                             24640000
         awake(ulogpin*pcbsize,%1,0);                                   24645000
         relsir(logsir,a);                                     <<01869>>24670000
         initlog:=true;                                                 24675000
         return;                                               <<01869>>24680000
      end                                                               24685000
      else                                                              24690000
      begin                                                             24695000
         relsir(logsir,a);                                     <<01869>>24700000
         initlog:=false;                                                24705000
         return;                                                        24710000
      end;                                                              24715000
   end;                                                                 24720000
end;                                                                    24725000
$page "Stop all logging processes on =SHUTDOWN, =LOGOFF"       <<01869>>24730000
procedure stop'all'userlogs;                                   <<01869>>24735000
   option privileged,uncallable;                               <<01869>>24740000
                                                               <<01869>>24745000
begin                                                          <<01869>>24750000
                                                               <<01869>>24755000
<< called by progen when performing a =shutdown or =logoff.  >><<01869>>24760000
<< at this time we need to make sure all user logging        >><<01869>>24765000
<< processes will end gracefully.                            >><<01869>>24770000
<<                                                           >><<01869>>24775000
                                                               <<01869>>24780000
integer                                                        <<01869>>24785000
   stack,           << stack upon entry/exit       >>          <<01869>>24790000
   tabindex;        << pointer to logtab entries   >>          <<01869>>24795000
                                                               <<01869>>24800000
                                                               <<01869>>24805000
                                                               <<01869>>24810000
stack := exchangedb(logdst);                                   <<01869>>24815000
tabindex := logtab(inuse);   << first entry in table.        >><<01869>>24820000
                                                               <<01869>>24825000
<< now cycle thru the table stopping the processes.          >><<01869>>24830000
                                                               <<01869>>24835000
while (tabindex <> null)  and  (tabindex <> "  ")  do          <<01869>>24840000
begin        << found an active one >>                         <<01869>>24845000
                                                               <<01869>>24850000
   << if the process is recovering or initializing, we do not>><<01869>>24855000
   << want to disturb it. instead we'll wait.                >><<01869>>24860000
                                                               <<01869>>24865000
   if logtab(status) = act  or  logtab(status) = inact  then   <<01869>>24870000
   begin                                                       <<01869>>24875000
      if logtab(dst) <> null then                              <<01869>>24880000
      begin                                                    <<01869>>24885000
         << found a live process to stop. >>                   <<01869>>24890000
                                                               <<01869>>24895000
         exchangedb(logtab(dst));                              <<01869>>24900000
         logbuff(numuser) := 0;                                <<01869>>24905000
         logbuff(msg) := stop;                                 <<01869>>24910000
         awake(logbuff(logpin),%20,0);                         <<01869>>24915000
         exchangedb(logdst);                                   <<01869>>24920000
      end;                                                     <<01869>>24925000
   end;                                                        <<01869>>24930000
                                                               <<01869>>24935000
   delay(2000d);                                               <<01869>>24940000
   tabindex := logtab(inuse);   << back to the top          >> <<01869>>24945000
end;         << found an active process  >>                    <<01869>>24950000
                                                               <<01869>>24955000
exchangedb(stack);                                             <<01869>>24960000
                                                               <<01869>>24965000
end;         << stop'all'userlogs >>                           <<01869>>24970000
$page  "STOPLOG -- stops individual log processes"             <<01869>>24975000
logical procedure stoplog(logname);                                     24980000
byte array logname;                                                     24985000
                                                                        24990000
option privileged,uncallable;                                           24995000
                                                                        25000000
                                                                        25005000
   <<this procedure stops user logging processes>>                      25010000
                                                                        25015000
                                                                        25020000
                                                                        25025000
begin                                                                   25030000
   logical array entry'(0:tentrysize-1) = q;                   <<01869>>25035000
   integer tabindex,orig'db;                                   <<01869>>25040000
   logical a;                                                  <<01869>>25045000
                                                               <<01869>>25050000
                                                               <<01869>>25055000
   a := getsir(logsir);                                        <<01869>>25060000
   if findlog(logname,tabindex) then                                    25065000
   begin                                                                25070000
      move'from'dseg(@entry',logdst,tabindex,tentrysize);      <<01869>>25075000
                                                               <<01869>>25080000
      tabindex:=0;                                                      25085000
      if (entry'(status)=recovering) or (entry'(status)=stop)  <<01869>>25090000
         or (entry'(status)=initializing)  then                <<01869>>25095000
      begin                                                    <<01869>>25100000
         stoplog:=false;                                       <<01869>>25105000
         relsir(logsir,a);                                     <<01869>>25110000
         return;                                               <<01869>>25115000
      end;                                                     <<01869>>25120000
      orig'db:=exchangedb(entry'(dst));    << to logbuff >>    <<01869>>25125000
                                                               <<01869>>25130000
      << need to tell the process to stop. the process will  >><<01869>>25135000
      << stop as soon as the user count goes to zero.        >><<01869>>25140000
                                                               <<01869>>25145000
      obtain(dlogbuff(resource),null);                         <<01869>>25150000
      logbuff(msg):= stop;                                              25155000
      release(dlogbuff(resource),null,1);                      <<01869>>25160000
                                                               <<01869>>25185000
      awake(logbuff(logpin),%20,0);                                     25190000
      stoplog:=true;                                                    25215000
      exchangedb(orig'db);                                              25220000
      relsir(logsir,a);                                        <<01869>>25225000
      return;                                                           25230000
   end                                                                  25235000
   else                                                                 25240000
   begin                                                                25245000
      relsir(logsir,a);                                        <<01869>>25250000
      stoplog:=false;                                                   25255000
      return;                                                           25260000
   end;                                                                 25265000
end;                                                                    25270000
$page  "DEL'LOCKWORRD"                                         <<01869>>25275000
procedure del'lockword(filename);                              <<01869>>25280000
   byte array filename;                                        <<01869>>25285000
   option uncallable,privileged;                               <<01869>>25290000
                                                               <<01869>>25295000
begin                                                          <<01869>>25300000
                                                               <<01869>>25305000
<< db must be at stack. >>                                              25310000
byte pointer                                                   <<01869>>25315000
   bps0   = s-0,                                               <<01869>>25320000
   pt,                 <<                                >>    <<01869>>25325000
   pt1,                << ptr to "/lockword"             >>    <<01869>>25330000
   pt2;                << ptr to ".group"                >>    <<01869>>25335000
                                                               <<01869>>25340000
integer                                                        <<01869>>25345000
   lock'len;                                                   <<01869>>25350000
                                                               <<01869>>25355000
move filename := filename while an, 1;                         <<01869>>25360000
if bps0 = "/" then                                             <<01869>>25365000
   begin         << found a lockword to delete >>              <<01869>>25370000
   @pt1 := @bps0;      << save address of "/"  >>              <<01869>>25375000
   @pt := @bps0 + 1;                                           <<01869>>25380000
   move pt := pt while an, 1;                                  <<01869>>25385000
   @pt2 := tos;        << save address of "."  >>              <<01869>>25390000
   lock'len := @pt2 - @pt1;   << length of lockword >>         <<01869>>25395000
   move pt1 := pt2, (36 - (@pt2 - @filename)), 2;              <<01869>>25400000
   @pt := tos;                                                 <<01869>>25405000
   pt := " ";                                                  <<01869>>25410000
   move pt(1) := pt, (lock'len-1), 2;                          <<01869>>25415000
   move * := 0;      << terminator for genmsg >>               <<01869>>25420000
   end;                                                        <<01869>>25425000
                                                               <<01869>>25430000
del;                                                           <<01869>>25435000
end;      << procedure del'lockword >>                         <<01869>>25440000
$page  "Utilities"                                             <<01869>>25445000
procedure move'from'dseg(target,segment,offset,count);         <<01869>>25450000
   value target,segment,offset,count;                          <<01869>>25455000
   integer target,segment,offset,count;                        <<01869>>25460000
   option privileged,uncallable,internal;                      <<01869>>25465000
                                                               <<01869>>25470000
                                                               <<01869>>25475000
                                                               <<01869>>25480000
                                                               <<01869>>25485000
begin                                                          <<01869>>25490000
                                                               <<01869>>25495000
   tos := target;                                              <<01869>>25500000
   tos := segment;                                             <<01869>>25505000
   tos := offset;                                              <<01869>>25510000
   tos := count;                                               <<01869>>25515000
   assemble (mfds 4);                                          <<01869>>25520000
                                                               <<01869>>25525000
                                                               <<01869>>25530000
                                                               <<01869>>25535000
end;                                                           <<01869>>25540000
                                                               <<01869>>25545000
                                                               <<01869>>25550000
                                                               <<01869>>25555000
procedure move'to'dseg(segment,offset,source,count);           <<01869>>25560000
   value segment,offset,source,count;                          <<01869>>25565000
   integer segment,offset,source,count;                        <<01869>>25570000
   option privileged,uncallable,internal;                      <<01869>>25575000
                                                               <<01869>>25580000
                                                               <<01869>>25585000
                                                               <<01869>>25590000
begin                                                          <<01869>>25595000
                                                               <<01869>>25600000
   tos := segment;                                             <<01869>>25605000
   tos := offset;                                              <<01869>>25610000
   tos := source;                                              <<01869>>25615000
   tos := count;                                               <<01869>>25620000
   assemble (mtds 4);                                          <<01869>>25625000
                                                               <<01869>>25630000
                                                               <<01869>>25635000
end;                                                           <<01869>>25640000
                                                               <<01869>>25645000
                                                               <<01869>>25650000
                                                               <<01869>>25655000
$control segment=main                                          <<01869>>25660000
end.                                                           <<01869>>25665000
