|
DataMuseum.dkPresents historical artifacts from the history of: RC4000/8000/9000 |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about RC4000/8000/9000 Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - metrics - download
Length: 59904 (0xea00)
Types: TextFile
Names: »trecoveri «
└─⟦01e83a425⟧ Bits:30008166 Bånd med SW8010 og SW8500 source code
└─⟦75ff9bef3⟧
└─⟦this⟧ »trecoveri «
isq-system recoveri, rel. 15.1, fb 1987.11.26
begin <*global block*>
comment
first version: ib, 15.12.78
corrections:
release 12.03, 17.3.80:
eah, 1.2.80: error in check of file containing unused bucks
eah, 15.2.80: break 0 when all records must be re-inserted
eah, 15.2.80: wrong keyfield-values in error mess. when cf-file
release 12.04 (pilot release):
eah, 15.8.80: error when bucket contains unused segments
eah, 11.9.80: break 0 when isq-file (erron. corr. of cf-file error)
release 13.0, 25.3.81:
eah, 22.1.81: assign savekeyi (erron. corr. of break 0, rel.12.04)
eah, 22.1.81: changed ok message from check-phase
eah, 23.1.81: error when all segments in bucket used
(erron.corr. of unused segm. rel.12.04)
eah, 23.1.81: wrong segm.no in error 15 (unused buckets)
eah, 25.3.81: init empty_file and recpart, and save the empty_file
status in recovrec (type 0) for separate
run.check/run.recoveri
release 15.1 1988.01.01
fb, 26.11.87: integer exeption when isq files exeeded 16384 segments
;
boolean recoverfiles, list, duplicate, fix, testout;
integer testbits, runtype, maxerror, duptype, dupaddr, freecore, noofsegmi,
nkey, maxreclength, mubucks, maxbucks, segsperbuck, segsperblock,
i, j, i0, i1, i2, i3, i4, i5, i6, i7, i8, i10, i11, descr, file,
bucks, blocks, recs, buelems, blelems, blocksperbuck, blocksperbuck1,
bucktablesize, maxrecsize, minrecsize, updmark, isqfilestate,
insertfilestate, recoverfilestate, docfilestate, monres, zoneconst,
shareconst, packedkeysize, date, docpage, doclineno, docpos, point,
snthis, snnext;
long noofrecs, recbytes, xrecs, xbytes;
real time, clock;
integer field ifi, ubff, upmf;
long field lfi, norf, nobf;
real field rfi;
integer array recdescr(1:20+2, 1:2), first, entrysize, last, shl,
recbase, curr, ub, sn(1:6), ia(1:20);
real array ra, isqfile, insertfile, recoverfile, docfile(1:2), timemea(1:5, 1:2);
integer array field savekeyi;
real array field raf;
long array field laf;
zone zhead(256, 1, stderror), zdoc(256, 2, stderror);
\f
<* recoveri outer block page ...1/1...
ib, eah, 15.2.80 *>
procedure alarm(alarmno, alarmcause, alarmtext);
integer alarmno, alarmcause;
string alarmtext;
system(9, alarmcause, alarmtext); <*prelim. procedure*>
procedure doc(doccase, param1, param2);
integer doccase, param1, param2;
begin
doclines(2);
write(zdoc, <:<10>:>);
case doccase of
begin
write(zdoc, <:records inserted: :>, param1,
<:, duplicates skipped: :>, param2);
write(zdoc, <:**13 file descript. segm.no::>, << dddd>, param1,
<: recs::>, << d>, xrecs -noofrecs, <: hwords::>, xbytes -recbytes,
if updmark <> 0 then <: update mark found:> else <::>, <:<10>:>);
end;
end doc;
procedure doclines(lines);
integer lines;
begin
if docfilestate = -1 then
begin
i:= 1;
open(zdoc, 4, docfile, 0);
docfilestate:= 0;
doclineno:= 1000;
docpage:= 0;
end;
doclineno:= doclineno +lines;
if doclineno > 60 then
begin
i:= 1;
docpage:= docpage +1;
write(zdoc, <:<12><10>isq-system recovery documentation:>,
<< dddddd>, date, <:.:>, <<zddd>, clock,
<: file: :>, isqfile.laf,
"sp", 10, <:page :>, <<d>, docpage, <:<10><10>:>);
doclineno:= lines;
end;
end doclines;
\f
<* recoveri outer block page ...1/2...
ib, eah 15.2.80 *>
procedure docfeed(pos);
value pos ;
integer pos ;
begin
docpos:= docpos +pos;
if docpos > 70 then
begin
docpos:= 17;
write(zdoc, <:<10>:>, false add 32, 20);
end;
end docfeed;
procedure docrec(record);
real array record;
begin
integer type;
<**>
for i:= 1 step 1 until nkey do
begin
type:= abs recdescr(i, 1);
ifi:= recdescr(i, 2);
case type of
begin
<*1*> write(zdoc, <: :>, if ifi mod 2 = 0 then record.ifi extract 12
else record.ifi shift (-12));
<*2*> write(zdoc, <: :>, record.ifi);
<*3*> begin
lfi:= ifi;
write(zdoc, <: :>, record.lfi);
end;
<*4*> begin
rfi:= ifi;
write(zdoc, <: :>, record.rfi);
end;
end case;
end for;
end docrec;
procedure outwarn(type, run, n);
value type, run, n ;
integer type, run, n ;
write(out, <:<10>***isq-:>, if run = 1 then <:check:> else <:recover:>,
<: warning::>, << d>, n, <: error:>, if n > 1 then <:s:> else <::>, <:<10>:>);
\f
<* recoveri outer block page ...1/3...
ib, eah 15.2.80 (15.8.80) *>
procedure testprint(printtype, int, text);
integer printtype, int ;
string text ;
begin
comment the test printing is controlled by the entry field (tail(9)
of the catalog tail of the isqfile
;
if testout == false and printtype <> 1 then goto finis;
trap(finis);
write(out, <:<10>*:>, text, << d>, int);
if printtype < 3 <*maxcase +1*> then
begin
case printtype of
begin
begin <*1: descriptions*>
write(out, <:<10> file bucks blocks recs buelems blelems<10>:>);
for i:= 1 step 1 until 8 do
begin
write(out, <:<10>:>, case i of
(<:firs:>, <:ensz:>, <:last:>, <:shl :>, <:recb:>, <:curr:>,
<:ub :>, <:sn :>));
for j:= 1 step 1 until 6 do
write(out, <<-ddddddd>, case i of
(first(j), entrysize(j), last(j), shl(j), recbase(j), curr(j),
ub(j), sn(j)));
end i;
write(out, <:<10>:>);
end;
<*2: indescr*>
write (out, <: snthis, snnext::>, <<-dddd>, snthis, snnext);
end
end;
trap(printtype);
finis:
end testprint;
procedure taketime;
begin
point:= point +1;
timemea(point, 1):= systime(1, time, timemea(point, 2));
end taketime;
comment start of outer block;
trapmode:= 1 shift 10; <*no end message*>
systime(1, 0, time);
date:= systime(4, time, clock);
clock := clock/100;
point := 0;
laf := 0;
docfilestate:= -1;
trap(finisdoc);
testout:= false;
\f
<* recoveri block fp-parameters page ...2/1...
ib, eah 15.2.80 *>
begin <*block fp-parameters*>
<*checks and initializes program parameters*>
integer int, item, paramno, seperator;
real n1;
real array name(1:2);
procedure nextfp;
comment reads the next fp-parameter.
global quantities:
seperator 1: <s>, 2: =, 3: <point>, 4: <end of param>,
0: <nl>.
item 1: <integer>, 2: <name>.
paramno the number of the preceeding parameter, it is
increased by one in the procedure.
int will hold an integer parameter.
name will hold a name parameter.
n1 n1 = name(1) shift (-24) shift 24.
;
begin
paramno:= paramno + 1;
i:= system(4, paramno, name);
item:= if i extract 12 = 4 then 1 else 2;
if item = 1 then int := name(1);
i := i shift (-12);
seperator:= if i = 4 then 1 else
if i = 6 then 2 else
if i = 8 then 3 else
if i = 2 then 0 else
4;
if seperator <> 4 then
n1:= name(1) shift (-24) shift 24;
end nextfp;
comment read the fp-parameters;
<* set default values*>
runtype:= 3;
maxerror := 8388607;
duptype:= dupaddr:= 0;
isqfile(1):= isqfile(2):=
insertfile(1):= insertfile(2):=
recoverfile(1):= recoverfile(2):=
docfile(1):= docfile(2):= real <::>;
recoverfiles:= list:= duplicate:= false;
paramno:= -1;
\f
<* recoveri block fp-parameters page ...2/2...
ib, eah 15.2.80 *>
nextfp; <*take programname*>
nextfp; <*filename*>
if seperator <> 1 or item <> 2 then alarm(1, paramno,
<:<10>progcall:>);
isqfile(1):= name(1);
isqfile(2):= name(2);
nextfp; <*recoverfiles or doc*>
if seperator <> 1 or item <> 2 then alarm(1, paramno,
<:<10>progcall:>);
insertfile(1):= name(1);
insertfile(2):= name(2);
nextfp; <*recoverfiles or after doc*>
if seperator = 1 then
begin <*must be recoverfiles*>
if item <> 2 then
alarm(1, paramno, <:<10>progcall:>);
recoverfile(1):= name(1);
recoverfile(2):= name(2);
recoverfiles:= true;
nextfp; <*must be doc*>
if seperator <> 1 or item <> 2 or name(1) <> real<:doc:> then
alarm(1, paramno, <:<10>progcall:>);
nextfp; <*after doc*>
end
else
if insertfile(1) <> real <:doc:> then
alarm(1, paramno, <:<10>progcall:>);
if seperator <> 3 or item <> 2 then
alarm(1, paramno, <:<10>progcall:>);
docfile(1):= name(1);
docfile(2):= name(2);
open (zdoc, 4, docfile, 0);
write (zdoc, "em",1); <*init docfile*>
close (zdoc, false);
\f
<* recoveri block fp-parameeters page ...2/3...
ib, eah 15.2.80 *>
nextfp; <*.list or <space>keyword*>
if seperator = 3 then
begin
if name(1) = real <:list:> then
list:= true
else
alarm(1, paramno, <:<10>progcall:>);
nextfp; <*keyword*>
end;
if seperator = 4 then goto endparam;
if seperator <> 1 or item <> 2 then
alarm(1, paramno, <:<10>progcall:>);
if name(1) = real <:run:> then
begin
nextfp;
if seperator <> 3 or item <> 2 then
alarm(1, paramno, <:<10>progcall:>);
if name(1) = real <:check:> then runtype:= 1 else
if name(1) shift (-8) shift 8 = real <:recov:> then
runtype:= 2 else
if name(1) <> real <:all:> then
alarm(1, paramno, <:<10>progcall:>);
nextfp;
if seperator = 4 then goto endparam;
if seperator <> 1 or item <> 2 then
alarm(1, paramno, <:<10>progcall:>);
end run;
\f
<* recoveri block fp-parameters page ...2/4...
ib, eah 15.2.80 *>
if name(1) = real <:dup:> then
begin
nextfp; <*type*>
if seperator <> 3 or item <> 2 then
alarm(1, paramno, <:<10>progcall:>);
if name(1) = real <:half:> then duptype:= 1 else
if name(1) shift (-8) shift 8 = real <:integ:> then
duptype:= 2 else
if name(1) = real <:long:> then duptype:= 3 else
if name(1) = real <:real:> then duptype:= 4 else
alarm(1, paramno, <:<10>progcall:>);
nextfp; <*addr*>
if seperator <> 3 or item <> 1 then
alarm(1, paramno, <:<10>progcall:>);
dupaddr:= int;
nextfp; <*order or next*>
if seperator = 3 then
begin
if item <> 2 then
alarm(1, paramno, <:<10>progcall:>);
if name(1) = real <:des:> then duptype:= -duptype else
if name(1) <> real <:asc:> then
alarm(1, paramno, <:<10>progcall:>);
nextfp;
end;
duplicate:= true;
end dup;
if seperator = 4 then goto endparam;
if seperator <> 1 or item <> 2 then
alarm(1, paramno, <:<10>progcall:>);
if name(1) <> real <:max:> then
alarm(1, paramno, <:<10>progcall:>);
nextfp; <*max errors*>
if seperator <> 3 or item <> 1 then
alarm(1, paramno, <:<10>progcall:>);
maxerror:= int;
endparam:
end; <* block take fp-parameters*>
\f
<* recoveri init file-descriptions page ...3/1...
ib, eah, 14.2.80 *>
<*6 descriptions used as indexes to description tables:*>
file:= 1; bucks:= 2; blocks:= 3; recs:= 4; buelems:=5; blelems:= 6;
isqfilestate:= insertfilestate:= recoverfilestate:= -1;
<*lookup isqfile and check the head*>
i:= 1;
taketime;
open(zhead, 4, isqfile, 0);
monres:= monitor(42, zhead, 0, ia);
if monres <> 0 then alarm(2, monres, <:<10>lookup:>);
noofsegmi:= ia(1);
testbits:= ia(9) extract 12;
headparamsi(zhead, recdescr, nkey, maxreclength, maxbucks,
segsperbuck, segsperblock);
fix:= recdescr(nkey+1, 1) = 0;
comment read the filehead;
setposition(zhead, 0, 0);
inrec6(zhead, 1024);
<*set the isq field bases*>
ifi:= 2;
i0 := zhead.ifi +1;
i1 := i0 + 14;
i2 := i1 + 20;
i10:= 18;
i11:= 4;
i3 := i2 + 26;
i4 := i3 + i10;
i5 := i4 + i10;
i6 := i5 + i10 + 2;
i7 := i6 + 30;
i8 := i7 + 30;
\f
<* recoveri init file descriptions page ...3/2...
ib, eah 15.2.80 (22.1.81) *>
<*init the description tables and other entities from the file- and buckhead*>
entrysize(file):= entrysize(recs):= 0;
ifi:= i3 + 4;
entrysize(bucks):= zhead.ifi;
packedkeysize:= entrysize(bucks) - i11;
ifi:= i0;
savekeyi := zhead.ifi - packedkeysize - (if fix then 0 else 2);
ifi:= i4 + 4;
entrysize(blocks):= zhead.ifi;
entrysize(buelems):= entrysize(blelems):= 2 * packedkeysize + 6;
ifi:= i2 + 20;
blocksperbuck:= zhead.ifi extract 12;
blocksperbuck1:= zhead.ifi shift (-12);
sn(file):= sn(blocks):= sn(recs):= sn(buelems):= sn(blelems):= 0;
sn(bucks):= (i7-1)//512 + 1;
ifi:= i2 + 14;
bucktablesize:= zhead.ifi;
ifi:= i2 + 16;
maxrecsize:= zhead.ifi;
ifi:= i2 + 18;
minrecsize:= zhead.ifi + 1;
\f
<* recoveri init file-descriptions page ...3/3...
ib, eah 15.2.80 (15.8.80) *>
comment read the bucket table head;
setposition(zhead, 0, sn(bucks));
inrec6(zhead, 512);
last(file):= last(blocks):= last(recs):= last(buelems):= last(blelems):= -1;
ub(file):= ub(blocks):= ub(recs):= ub(buelems):= ub(blelems):= -1;
first(file):= first(blocks):= first(recs):= first(buelems):= first(blelems):= 0;
first(bucks):= i8 - i7;
ifi:= 2;
mubucks:= (zhead.ifi -first(bucks))//entrysize(bucks);
norf:= 6;
noofrecs:= zhead.norf;
xrecs:= 0;
ubff:= 8;
ub(bucks):= zhead.ubff;
last(bucks):= ub(bucks) + first(bucks) - entrysize(bucks);
nobf:= 14;
recbytes:= zhead.nobf;
xbytes:= 0;
upmf:= 16;
updmark:= zhead.upmf;
shl(file):= sn(bucks)*128;
shl(bucks):= (i8 - i7 + maxbucks*entrysize(bucks) + 511)//512*128;
shl(blocks):= (blocksperbuck*entrysize(blocks) + 511)//512*128;
shl(recs):= segsperblock* 128;
shl(buelems):= ((mubucks + 1)* entrysize(buelems) +3)//4;
shl(blelems):= ((blocksperbuck + 1)*entrysize(blelems) +3)//4;
zoneconst:= 50;
shareconst:= 26;
close(zhead, false);
for i:= 1 step 1 until 6 do curr(i):= recbase(i):= -1;
comment testprint of initialised variables;
if testbits shift (-7) extract 1 = 1 then
begin
write (out, <:<10>recover initializing:>, << -dddddddd>,
<:<10> mubucks, noofrecs, recbytes, upd.mark, savekeyi<10>:>,
mubucks, noofrecs, recbytes, updmark, savekeyi,
<:<10>segsprbuck, segsprbl, noofsegm<10>:>,
segsperbuck,segsperblock,noofsegmi,
<:<10> blprbuck,blprbuck1,bucktabsz, maxrecsz, minrecsz<10>:>,
blocksperbuck,blocksperbuck1,bucktablesize,maxrecsize,minrecsize,
<:<10>recdescr::>);
for i := 1 step 1 until nkey+1 do
write (out, <<-ddddd>, recdescr(i,1), recdescr(i,2), "nl",1,"sp",9);
testout := true;
testprint (1, 1, <:init:>);
testout := false;
end;
\f
<* recoveri block recover zones page ...4/1...
ib, eah 15.2.80 (25.3.81) *>
begin <*block common for check and recover*>
boolean dissolve, file_empty;
integer nerrorfile, nerrorbuck, nrecov;
integer field lenf, rectypef, sort1f, sort2f;
integer array field varpart;
real array recoverrec(1:43);
zone zbucks(shl(bucks), 1, stderror), zblocks(shl(blocks), 1, stderror),
zrecs(shl(recs), 1, stderror), zrecov(256, 2, stderror);
procedure inrecover;
begin
comment*
if testout then testprint(4, nrecov, <:irecov:>);
if recoverfilestate = -1 then
begin
i:= 1;
nrecov:= opensq(zrecov, string recoverfile(increase(i)), 0, 0);
recoverfilestate:= 0;
end;
if nrecov > 0 then
begin
invar(zrecov);
if testbits shift (-9) extract 1 = 1 then
printrecover;
nrecov:= nrecov -1;
end
else
recoverfilestate:= 1;
end inrecover;
\f
<* recoveri block recover zones page ...4/2...
ib, eah 15.2.80 (25.3.81) *>
procedure outrecover;
begin
if testout then testprint(4, recoverrec.rectypef, <:orecov:>);
if recoverfiles then
begin
if recoverfilestate < 0 then
begin
i:= 1;
opensq(zrecov, string recoverfile(increase(i)), 0,
if recover_filestate = -2 then 3 <*output continued*>
else 2 <*new output*> );
recoverfilestate:= 0;
dissolve:= false;
end;
dissolve:= dissolve or recoverrec.rectypef = 4;
outvar(zrecov, recoverrec);
if testbits shift (-9) extract 1 = 1 then
printrecover;
nrecov:= nrecov +1;
end;
end outrecov;
procedure printrecover;
begin
integer field vf;
write (out, <:<10>recovrec:>, zrecov.lenf, zrecov.rectypef,
zrecov.sort1f, zrecov.sort2f);
i := zrecov.lenf;
for vf := varpart+2 step 2 until i do
write (out, zrecov.vf);
end;
trap(trapl);
nrecov:= nerrorfile:= 0;
lenf:= 2;
rectypef:= 6;
sort1f:= 8;
sort2f:= 10;
varpart:= sort2f;
dissolve:= file_empty:= false;
\f
<* recoveri block insertfile page ...5/1...
eah, 12.2.80 (25.3.81) *>
begin <*block write insertfile*>
integer shlsuper, snsuper, ninsert, insertrecbase;
integer field ubf, snf, bucksnf;
integer array field iaf, iaf1, firstkey, lastkey;
real array field recpart;
zone zinsert((maxrecsize + 4 + 511)//512*256, 2, stderror),
insertrec(maxreclength +1, 1, stderror);
boolean procedure ininsert;
begin
comment *;
if testout then testprint(4, ninsert, <:iinsert:>);
if insertfilestate = -1 then
begin
i:= 1;
ninsert:= opensq(zinsert, string insertfile(increase(i)), 0, 0);
insertfilestate:= 0;
end;
if ninsert <> 0 then
begin
invar(zinsert);
ninsert:= ninsert -1;
ininsert:= true;
end
else
ininsert:= false;
end ininsert;
procedure outinsert;
begin
if insertfilestate = -1 then
begin
if testout then testprint(4, ninsert, <:oinsert:>);
i:= 1;
opensq(zinsert, string insertfile(increase(i)), 0, 2);
insertfilestate:= 0;
end;
outvar(zinsert, insertrec);
ninsert:= ninsert +1;
end outinsert;
\f
<* recoveri block insertfile page ...5/2...
ib, eah 15.2.80 (25.3.81) *>
ninsert:= 0;
recpart:= 4;
if runtype = 2 then goto recover;
ubf:= 2;
snf:= firstkey:= 4;
lastkey:= firstkey + packedkeysize;
bucksnf:= lastkey +packedkeysize +2;
getzone6(insertrec, ia);
insertrecbase:= ia(14);
freecore:= system(2, i, ra)
-50 <*stack appetites*>
-5*512 <*extra program segments*>
-3*zoneconst - 4*shareconst <*coming zones*>
-4*shl(buelems) -4*shl(blelems)
;
i:= if freecore // 512 >= noofsegmi then 1 else 2;
shlsuper:= if i = 1 then noofsegmi*128 else (freecore +1023)//1024*128;
if testbits shift (-8) extract 1 = 1 then
write(out, << d>, freecore, i , shlsuper);
if shlsuper < 128 then alarm(3, freecore, <:<10>freecore:>);
\f
<* recoveri block superbuf page ...6/1...
eah 12.2.80 (15.8.80) *>
begin <*block superbuf*>
integer w0, w1, w3, nbucks, nblocks;
zone zsuper(shlsuper*i, i, stderror),
zbuelems(shl(buelems), 1, stderror), zblelems(shl(blelems), 1, stderror);
procedure checkzero(lastrecs);
integer lastrecs;
begin
comment finds the last non-zero word in the recordzone;
integer lst;
lst:= 0;
ifi:= shl(recs)*4;
while ifi > 0 and lst = 0 do
if zrecs.ifi <> 0 then
lst:= first(recs) + ifi
else
ifi:= ifi -2;
lastrecs := lst;
end checkzero;
\f
<* recoveri block superbuf page ...6/2...
ib, eah 15.2.80 *>
procedure checkrecs;
begin
integer nrecs;
procedure errorrec(errortype);
integer errortype;
begin
nerrorbuck:= nerrorbuck +1;
case errortype of
begin
;
docerror(1, zrecs, recs, 11111);
docerror(3, zrecs, recs, 11011);
end;
recoverrec.lenf:= varpart +4;
recoverrec.rectypef:= 3;
recoverrec.sort1f:= recoverrec.varpart(1):= sn(recs);
recoverrec.sort2f:= 0;
recoverrec.varpart(2):= sn(blocks);
outrecover;
goto finischeck;
end errorrec;
nrecs:= 0;
curr(recs):= first(recs);
checkzero(last(recs));
if last(recs) = first(recs) then goto finischeck;
w3:= recbase(recs) + first(recs);
systemi(zhead, 4<*savekey*>, w0, w1, w3);
nrecs:= 1;
if fix then
begin
w3:= w3 +maxrecsize;
while w3 < recbase(recs) + last(recs) do
begin
curr(recs):= curr(recs) +maxrecsize;
systemi(zhead, 0<*compare1*>, w0, w1, w3);
if w0 >= 0 then errorrec(3);
systemi(zhead, 4<*savekey*>, w0, w1, w3);
w3:= w3 +maxrecsize;
nrecs:= nrecs + 1;
end keycheck;
last(recs):= w3 - recbase(recs);
end fix
else
begin <*var*>
while w3 < recbase(recs) + last(recs) do
begin
systemi(zhead, 10<*getsize*>, w0, w1, w3);
if w1 < minrecsize or w1 > maxrecsize then
errorrec(2);
w3:= w3 + w1;
entrysize(recs):= w1;
curr(recs):= curr(recs) +w1;
end sizecheck;
last(recs):= w3 -recbase(recs);
w3:= recbase(recs) + first(recs);
curr(recs):= first(recs);
systemi(zhead, 10<*getsize*>, w0, w1, w3);
w3:= w3 +w1;
while w3 < recbase(recs) + last(recs) do
begin
curr(recs):= curr(recs) +w1;
systemi(zhead, 0<*compare1*>, w0, w1, w3);
if w0 >= 0 then errorrec(3);
systemi(zhead, 4<*savekey*>, w0, w1, w3);
systemi(zhead, 10<*getsize*>, w0, w1, w3);
w3:= w3 +w1;
nrecs:= nrecs + 1;
end keycheck;
end var;
<* recs accepted*>
w3:= recbase(blelems) + curr(blelems) + lastkey;
systemi(zhead, 8<*copykey*>, w0, w1, w3);
w3:= recbase(recs) + first(recs);
systemi(zhead, 4<*savekey*>, w0, w1, w3);
w3:= recbase(blelems) + curr(blelems) + firstkey;
systemi(zhead, 8<*copykey*>, w0, w1, w3);
iaf:= curr(blelems);
zblelems.iaf.ubf:= last(recs) - first(recs);
zblelems.iaf.snf:= sn(recs);
zblelems.iaf.bucksnf:= sn(blocks);
xrecs:= xrecs + nrecs;
nblocks:= nblocks + 1;
xbytes:= xbytes + last(recs) - first(recs);
last(blelems):= curr(blelems):= curr(blelems) + entrysize(blelems);
finischeck:
end checkrecs;
\f
<* recoveri block superbuf page ...6/3...
ib, eah 15.2.80 *>
boolean
procedure checktable(ztable, zsort, descrt, descrs);
zone ztable, zsort ;
integer descrt, descrs ;
begin
integer array field inxt, inxs;
integer result;
comment*
if testout then testprint(1, descrt, <:chtab:>);
inxt:= first(descrt);
inxs:= first(descrs);
result:= 1;
while inxs < last(descrs) and result > 0 do
begin
i:= 1;
while i <= entrysize(descrt)//2 and result > 0 do
begin
if ztable.inxt(i) <> zsort.inxs(i) then
begin
if i <= firstkey//2 then result:= 0
else
begin <*enclosing key in table may be legal*>
result:= 2;
savekey2(ztable.inxt.firstkey);
w3:= recbase(descrs) +inxs +firstkey;
systemi(zhead, 2<*compare2*>, w0, w1, w3);
if w0 > 0 then result:= 0
else
if inxs <> first(descrs) then
begin
w3:= recbase(descrs) +inxs -entrysize(descrs) +lastkey;
systemi(zhead, 2<*compare2*>, w0, w1, w3);
if w0 <= 0 then result:= 0;
end;
if result > 1 then
begin
w3:= recbase(descrs) +inxs +firstkey;
systemi(zhead, 8<*copykey*>, w0, w1, w3);
result:= 1;
i:= entrysize(descrt)//2;
end;
end enclosing key test;
end <>;
i:= i +1;
end i;
inxs:= inxs +entrysize(descrs);
inxt:= inxt +entrysize(descrt);
end entries;
checktable:= result > 0;
end checktable;
\f
<* recoveri block superbuf page ...6/4...
ib, eah 15.2.80 *>
procedure dissolverecs;
begin
integer array field inx;
comment*
if testout then testprint(3, -1, <:disrecs:>);
lenf:= 2;
if fix then
begin
entrysize(recs):= w1:= maxrecsize;
insertrec.lenf:= w1 +4;
end fix;
checkzero(last(recs));
inx:= first(recs);
repeat
if -, fix then
begin
w3:= recbase(recs) + inx;
systemi(zhead, 10<*getsize*>, w0, w1, w3);
entrysize(recs):= w1;
insertrec.lenf:= w1 + 4;
end var;
tofrom(insertrec.recpart, zrecs.inx, w1);
outinsert;
xrecs:= xrecs - 1;
xbytes:= xbytes - w1;
inx:= inx +entrysize(recs);
until inx >= last(recs) or entrysize(recs) = 0;
end dissolverecs;
\f
<* recoveri block superbuf page ...6/5...
ib, eah 15.2.80 *>
procedure docerror(errortype, zdescr, descr, mask);
value errortype, descr, mask ;
integer errortype, descr, mask ;
zone zdescr ;
begin
integer fields, i;
if testout then testprint (10,errortype,<:docerror:>);
fields:= mask;
<*estimate lines to print*>
j:= 0;
for i:= 4, 5, 6 do
if (fields//(10**(i -1)) extract 24) mod 10 = 1 then
j:= j +1;
j:= j*packedkeysize*4;
doclines(if j < 30 then 2 else ((j -30)//40 +3));
write(zdoc, <:<10>**:>, <<zd>, errortype, <: :>, case errortype of (
<* 1*> <:rec. length :>,
<* 2*> <:cleared block :>,
<* 3*> <:key sequence :>,
<* 4*> <:overlap block :>,
<* 5*> <:new blocktable :>,
<* 6*> <:overlap bucket :>,
<* 7*> <:new buckettable:>,
<* 8*> <:buckethead :>,
<* 9*> <:blocktab. error:>,
<*10*> <:bucket delete :>,
<*11*> <:buck.tab. error:>,
<*12*> <:file delete :>,
<*13*> <::>, <*no 13 is used in procedure doc*>
<*14*> <::>, <*no 14 - - for errors during recovery*>
<*15*> <:unused buckets :>,
<*max*> <::>)
);
i:= 0;
docpos:= 20;
while fields <> 0 do
begin
i:= i +1;
j:= fields mod 10;
if j = 1 then
begin
case i of
begin
<*1*> begin
docfeed(12);
write(zdoc, <: segm.no::>);
if descr <> buelems and descr <> blelems then
write(zdoc, << dddd>, sn(descr))
else
begin
iaf:= curr(descr);
write(zdoc, << dddd>, zdescr.iaf.snf);
end
end;
<*2*> begin
docfeed(12);
write(zdoc, <: field::>, << d>, curr(recs));
end;
<*3*> begin
docfeed(13);
write(zdoc, <: length::>, << d>, w1//4);
end;
<*4*> begin
docfeed(7 +packedkeysize*4);
write(zdoc, <: record::>);
raf:= curr(descr);
docrec(zdescr.raf);
end;
<*5*> begin <*first record, packed or direct*>
docfeed(11 +packedkeysize*4);
write(zdoc, <: first rec.::>);
if descr = recs then
begin
raf:= first(recs);
docrec(zrecs.raf);
end
else
begin
iaf:= curr(descr) +firstkey;
savekey2(zdescr.iaf);
w3:= insertrecbase;
systemi(zhead, 6<*restore*>, w0, w1, w3);
docrec(insertrec);
end;
end <*first*>;
<*6*> begin <*last record, packed*>
docfeed(9 +packedkeysize*4);
write(zdoc, <: last rec.::>);
iaf:= curr(descr) +lastkey;
savekey2(zdescr.iaf);
w3:= insertrecbase;
systemi(zhead, 6<*restore*>, w0, w1, w3);
docrec(insertrec);
end <*last*>;
end case i;
end if;
fields:= fields//10;
end while;
write(zdoc, <:<10>:>);
end docerror;
\f
<* recoveri block superbuf page ...6/6...
ib, eah 15.2.80 *>
procedure elemsort(zsort, descr);
zone zsort ;
integer descr ;
begin
integer entsize, top;
integer array field inx, winner, current;
entsize:= entrysize(descr);
comment *
if testout then testprint(3, descr, <:elsort:>);
top:= last(descr) -entsize;
comment *;
if testout then printsh(zsort, descr);
for winner:= first(descr) step entsize until top do
begin <*all elements*>
current:= winner;
savekey2(zsort.winner.firstkey);
for inx:= winner + entsize step entsize until top do
begin <*remaining elements*>
w3:= recbase(descr) + inx + firstkey;
if testout then
write(out,<:<10>inx,current,w3,w0:>,<<-ddddd>,
inx,current,w3,w0);
systemi(zhead, 2<*compare2*>, w0, w1, w3);
if w0 > 0 <*savekeyi > reckey*> then
begin
savekey2(zsort.inx.firstkey); <*possible winner*>
current:= inx;
end
end inx;
if current <> winner then
for i:= 1 step 1 until entsize//2 do
begin
j:= zsort.current(i);
zsort.current(i):= zsort.winner(i);
zsort.winner(i):= j;
end i;
end winner;
comment *
if testout then printsh(zsort, descr);
end elemsort;
\f
<* recoveri block superbuf page ...6/7...
ib, eah 15.2.80 *>
procedure errorentry(zelems, edescr, currinx);
zone zelems ;
integer edescr, currinx ;
begin comment sends transactions for delete of blocks;
integer i, j;
integer array field inx;
if testout then testprint(3, edescr, <:errent:>);
inx:= currinx;
recoverrec.lenf:= varpart +4;
recoverrec.rectypef:= if edescr = buelems then 5 else 4;
recoverrec.sort1f:= recoverrec.varpart(1):= zelems.inx.snf;
recoverrec.sort2f:= 0;
recoverrec.varpart(2):= zelems.inx.bucksnf;
outrecover;
if edescr = buelems then
begin
recoverrec.rectypef:= 4;
i:= zelems.inx.snf;
j:= i +segsperbuck -shl(blocks)//128 -(if i < segsperbuck then
shl(file)//128 +shl(bucks)//128 else 0);
for i:= i +shl(blocks)//128 step segsperblock until j do
begin
recoverrec.sort1f:= recoverrec.varpart(1):= i;
outrecover;
nerrorfile:= nerrorfile +1;
end
end
else
nerrorbuck:= nerrorbuck +1;
end errorentry;
\f
<* recoveri block superbuf page ...6/8...
ib, eah 15.2.80 *>
procedure errortab(zelems, edescr);
zone zelems ;
integer edescr ;
begin comment sends transactions for creation of new tables;
integer array field inx;
if testout then testprint(3, edescr, <:errtab:>);
j:= 0;
recoverrec.lenf:= entrysize(edescr) +varpart;
recoverrec.rectypef:= if edescr = buelems then 1 else 2;
inx:= first(edescr);
recoverrec.sort1f:= zelems.inx.bucksnf;
for inx:= inx step entrysize(edescr) until last(edescr) -entrysize(edescr) do
begin
recoverrec.sort2f:= j:= j +1;
for i:= 1 step 1 until entrysize(edescr)//2 do
recoverrec.varpart(i):= zelems.inx(i);
outrecover;
end;
if j < (if descr = buelems then mubucks else blocksperbuck) then
filltab(zelems, edescr);
end errortab;
\f
<* recoveri block superbuf page ...6/9...
ib, eah 15.2.80 *>
procedure filltab(zelems, edescr);
value edescr ;
zone zelems ;
integer edescr ;
begin comment fills table with free blocks or buckets;
boolean found;
integer array field inx;
integer i, j, n, segm, tab, top;
recoverrec.lenf:= 20;
recoverrec.rectypef:= if edescr = buelems then 1 else 2;
for i:= 1 step 1 until entrysize(edescr)//2 -1 do
recoverrec.varpart(i):= 0;
tab:= if edescr = buelems then bucks else blocks;
recoverrec.sort1f:= recoverrec.varpart(entrysize(edescr)//2):= sn(tab);
top:= if tab = bucks then mubucks else
if sn(tab) < segsperbuck then blocksperbuck1 else blocksperbuck;
segm:= sn(tab) +shl(tab)//128;
n:= j:= if tab = bucks then nbucks else nblocks;
for i:= 1 step 1 until top do
begin
found:= false;
for inx:= first(edescr) step entrysize(edescr)
until (j-1) * entrysize(edescr) do
if zelems.inx.snf = segm then found:= true;
if -,found then
begin
recoverrec.varpart(2):= segm;
recoverrec.sort2f:= n:= n +1;
outrecover;
end;
if tab = bucks then
segm:= if segm < segsperbuck then
segsperbuck else segm +segsperbuck
else
segm:= segm +segsperblock;
end for;
end filltab;
\f
<* recoveri block superbuf page ...6/10...
ib, eah 15.8.80 (23.1.81) *>
boolean
procedure inisq(descr);
value descr;
integer descr;
begin
integer lg, srest;
if snnext < noofsegmi then
begin
inisq:= true;
case descr of
begin
begin <*head*>
superinrec(zhead, shl(file)*4);
snthis:= 0;
snnext:= shl(file)//128;
<*set abs. addr. in entrypoints to codepieces*>
for ifi:= i0 step 2 until i1 -2 do
zhead.ifi:= zhead.ifi +recbase(file) +1;
end;
begin <*bucks*>
superinrec(zbucks, shl(bucks)*4);
snthis:= snnext;
snnext:= snnext + shl(bucks)//128;
end;
begin <*blocks*>
if snnext//segsperbuck < mubucks then
begin
superinrec(zblocks, shl(blocks)*4);
snthis:= snnext;
snnext:= snnext + shl(blocks)//128;
end
else
begin <*unused buckets in the file*>
inisq := false;
sn(blocks) := mubucks * segsperbuck;
<*first unused segment in the file*>
docerror (15, zblocks, descr, 1);
end;
end;
begin <*recs*>
lg:= shl(recs)//128;
srest := snnext mod segsperbuck;
if srest = 0 then inisq := false
else
begin
srest := srest + lg - segsperbuck;
if srest > 0 then
begin
inisq := false; <*end of buck*>
if srest > 0 then
begin <*skip unused segments in bucket*>
superinrec(zrecs, srest*512);
snthis := snnext;
snnext := snnext + srest;
end;
end
else
begin
superinrec(zrecs, lg*512);
snthis:= snnext;
snnext:= snnext + lg;
end
end;
end
end case;
sn(descr):= snthis;
end
else <*end of file*>
inisq:= false;
if testout then
testprint(2, if snnext < noofsegmi then descr else -descr, <:indescr:>);
end inisq;
\f
<* recoveri block superbuf page ...6/11...
ib, eah 13.2.79 *>
procedure overlap(zsort, descr);
value descr ;
zone zsort ;
integer descr ;
begin comment checks overlapping in descriptiontables;
integer array field inx, inx1;
integer entsize;
comment *;
if testout then testprint(3, descr, <:overlap:>);
inx:= first(descr);
savekey2(zsort.inx.lastkey);
entsize:= entrysize(descr);
for inx:= inx + entsize step entsize until last(descr) -entsize do
begin
w3:= recbase(descr) + inx + firstkey;
systemi(zhead, 2<*compare2*>, w0, w1, w3);
if w0 >= 0 then
begin
curr(descr):= inx -entsize;
docerror(if descr = buelems then 6 else 4, zsort, descr, 110001);
errorentry(zsort, descr, inx - entsize);
curr(descr):= inx;
docerror(if descr = buelems then 6 else 4, zsort, descr, 110001);
errorentry(zsort, descr, inx);
inx1:= inx + entsize;
inx:= inx - entsize;
tofrom(zsort.inx, zsort.inx1, last(descr) - inx1 + entsize);
last(descr):= last(descr) - 2 * entsize;
if descr = buelems then
nbucks:= nbucks -2 else
nblocks:= nblocks -2;
end;
savekey2(zsort.inx.lastkey);
end for;
end overlap;
\f
<* recoveri block superbuf page ...6/12...
ib, eah 13.2.79 *>
procedure savekey2(packedkey);
integer array packedkey;
comment moves a packed key to savekey in the filehead;
for i:= 1 step 1 until packedkeysize//2 do
zhead.savekeyi(i):= packedkey(i);
procedure superget(zdescr, descr);
value descr ;
zone zdescr ;
integer descr ;
begin comment reads logical blocks directly from the file.
should not be mixed with superinrec;
if testout then testprint(3, sn(descr), <:sget:>);
if isqfilestate = -1 then
begin
open(zsuper, 4, isqfile, 0);
isqfilestate:= 0;
end;
setposition(zsuper, 0, sn(descr));
inrec6(zsuper, shl(descr)*4);
tofrom(zdescr, zsuper, shl(descr)*4);
end superget;
\f
<* recoveri block superbuf page ...6/13...
ib, eah 15.8.80 *>
procedure superinrec(zbuf, bufsize);
zone zbuf ;
integer bufsize ;
begin comment reads logical blocks sequentially from the file via the superbuffer;
own integer rest, supersize;
long array field bufaddr, superaddr;
if isqfilestate = -1 then
begin
open(zsuper, 4, isqfile, 0);
rest:= snsuper:= isqfilestate:= 0;
supersize:= shlsuper*4;
end;
i:= bufsize;
bufaddr:= 0;
superaddr:= supersize - rest;
comment *
if testout then
write(out, <:<10>superinrec: bufsize,-addr, supersize,-addr::>,
<<-dddd>, bufsize, bufaddr, supersize, superaddr);
while rest < i and supersize > 0 do
begin
if rest <> 0 then
begin
tofrom(zbuf.bufaddr, zsuper.superaddr, rest);
i:= i - rest;
bufaddr:= bufaddr + rest;
end;
if snsuper + shlsuper//128 > noofsegmi then
supersize:= (noofsegmi - snsuper)*512;
inrec6(zsuper, supersize);
rest:= supersize;
superaddr:= 0;
snsuper:= snsuper + supersize//512;
end rest < i;
if supersize > 0 then
begin
tofrom(zbuf.bufaddr, zsuper.superaddr, i);
rest:= rest - i;
end;
end superinrec;
procedure printsh(zdescr, descr);
value descr ;
zone zdescr ;
integer descr ;
begin comment testprint of logical block;
write(out, <:<10>sh:>, descr);
for ifi:= 2 step 2 until shl(descr)*4 do
write(out, if ifi mod entrysize(descr) = 2 then <:<10>:> else <: :>,
<<-ddddddd>, zdescr.ifi);
end printsh;
\f
<*recoveri check reading of isqfile page ...7/1...
ib,eah 12.2.80 (25.3.81) *>
comment start check reading of the file;
testout:= testbits shift (-10) extract 1 = 1;
if testbits shift (-8) extract 1 = 1 then
write(out, <:<10>free:>, system(2, i, ra));
nbucks:= nerrorfile:= snnext:= 0;
last(buelems):= curr(buelems):= 0;
for descr:= 1 step 1 until 6 do
begin
case descr of
begin
getzone6(zhead, ia);
getzone6(zbucks, ia);
getzone6(zblocks, ia);
getzone6(zrecs, ia);
getzone6(zbuelems, ia);
getzone6(zblelems, ia);
end;
recbase(descr):= ia(14);
end;
inisq(file);
inisq(bucks);
ifi:= 16;
if zbucks.ifi <*updmarks*> shift (-2) extract 1 = 1 then
alarm(9, 0, <:<10>initmark:>);
taketime;
\f
<* recoveri check reading of isqfile page ...7/2...
ib, eah 13.2.79 *>
comment start file reading loop;
while inisq(blocks) do
begin <*for each bucket*>
nblocks:= nerrorbuck:= 0;
curr(blocks):= curr(blelems):= 0;
if testout then testprint(1, nbucks, <:buck:>);
while inisq(recs) do <*for each block in this bucket*>
checkrecs;
if nblocks = 0 and nerrorbuck <> 0 then
begin <*no block with records in this bucket*>
recoverrec.lenf:= 12;
recoverrec.rectypef:= 5;
recoverrec.sort1f:= recoverrec.varpart(1):= sn(blocks);
recoverrec.sort2f:= 0;
outrecover;
docerror(10, zblocks, blocks, 10001);
filltab(zblelems, blelems);
end
else
begin <*some blocks with records accepted*>
if testout then testprint(1, nblocks, <:blelems:>);
elemsort(zblelems, blelems);
overlap(zblelems, blelems);
if nerrorbuck = 0 then
begin
if -, checktable(zblocks, zblelems, blocks, blelems) then
begin
<*not other errors than ub, sn, or key in table*>
docerror(9, zblocks, blocks, 10001);
errortab(zblelems, blelems);
nerrorbuck:= nerrorbuck +1;
end
end
else
begin
<*errors in some blocks, new table needed*>
docerror(5, zblocks, blocks, 1);
errortab(zblelems, blelems);
end;
if nblocks <*still*> > 0 then
begin <*create description element for the bucket*>
nbucks:= nbucks + 1;
iaf:= curr(buelems);
zbuelems.iaf.ubf:= (nblocks -1)*entrysize(blocks);
zbuelems.iaf.snf:= sn(blocks);
zbuelems.iaf.bucksnf:= sn(bucks);
iaf1:= first(blelems);
tofrom(zbuelems.iaf.firstkey,zblelems.iaf1.firstkey,
packedkeysize);
iaf1:= last(blelems) -entrysize(blelems);
tofrom(zbuelems.iaf.lastkey, zblelems.iaf1.lastkey,
packedkeysize);
last(buelems):= curr(buelems):= curr(buelems) + entrysize(buelems);
end
end;
nerrorfile:= nerrorfile + nerrorbuck;
end buckets;
\f
<* recoveri check reading of isqfile page ...7/3...
ib, eah 13.2.79 *>
if nbucks = 0 then
begin <*no buckets accepted, rare case*>
file_empty := true;
docerror(12, zbucks, bucks, 10001);
filltab(zbuelems, buelems);
end
else
begin <* some buckets accepted*>
elemsort(zbuelems, buelems);
overlap(zbuelems, buelems);
if nerrorfile = 0 then
begin
if -, checktable(zbucks, zbuelems, bucks, buelems) then
begin
docerror(11, zbucks, bucks, 10001);
errortab(zbuelems, buelems);
nerrorfile:= nerrorfile +1;
end
end
else
begin
docerror(7, zbucks, bucks, 1);
errortab(zbuelems, buelems);
end;
end;
ub(file):= (nbucks -1)*entrysize(bucks);
\f
<* recoveri check reading of isqfile page ...7/4...
ib, eah 13.2.79 (25.3.81) *>
taketime;
if dissolve then
begin
if recoverfilestate <> -1 then
begin
nrecov:= closesq(zrecov, false, false);
recoverfilestate:= -1;
end;
while recoverfilestate <> 1 do
begin
inrecover;
if zrecov.rectypef = 4 <*dissolve*> then
begin
sn(recs):= zrecov.varpart(1);
superget(zrecs, recs);
dissolverecs;
end;
end while;
nrecov:= closesq (zrecov, false, false);
recover_filestate:= -2;
if insertfilestate <> -1 then
begin
ninsert:= closesq(zinsert, false, true);
insertfilestate:= -1;
end;
end dissolve;
\f
<* recoveri check reading of isqfile page ...7/5...
eah 25.3.81 *>
if noofrecs <> xrecs or recbytes <> xbytes or updmark <> 0 then
begin
nerrorfile:= nerrorfile +1;
recoverrec.lenf:= varpart +12;
recoverrec.rectypef:= 0;
recoverrec.sort1f:= sn(bucks);
recoverrec.sort2f:= 0;
lfi:= 4;
recoverrec.varpart.lfi:= xrecs;
ifi:= lfi +2;
recoverrec.varpart.ifi:= ub(file);
lfi:= ifi +4;
recoverrec.varpart.lfi:= xbytes;
ifi:= lfi +2;
recoverrec.varpart.ifi:= if file_empty then 1 else 0;
outrecover;
doc(2, sn(bucks), 0);
nrecov:= closesq(zrecov, false, false);
recoverfilestate:= -1;
end;
if isqfilestate <> -1 then
begin
close(zsuper, false);
isqfilestate:= -1;
end;
end; <*block superbuf*>
\f
<* recoveri block sorting page ...8/1...
ib, eah 13.2.79 *>
if nrecov > 1 or ninsert > 1 then
begin <*block sort insertrecs and recoverrecs*>
integer result, explanation;
integer array param(1:7), keydescr(1:nkey+1, 1:2);
real array names(1:6);
param(1<*segsperinblock*>):= 0 <*sqfile*>;
param(2<*clear input*>):= 1 <*yes*>;
param(3<*segsperoutblock*>):= 0 <*sqfile*>;
param(4<*var.length*>):= 0 <*yes*>;
param(5<*maxrecsize*>):= maxrecsize + 4;
param(6<*noofkeys*>):= nkey + (if duplicate or
recdescr(nkey,2) + 1 < maxrecsize then 1 else 0);
param(7<*troubles*>):= 0 <*return with explanation*>;
comment sorting of insert file;
if ninsert > 1 then
begin
for j:= 1 step 1 until nkey do
begin
keydescr(j, 1):= recdescr(j, 1);
keydescr(j, 2):= recdescr(j, 2) +recpart;
end;
if -,duplicate then
begin
duptype:= 2;
dupaddr:= keydescr(nkey, 2) +recpart +2;
end;
keydescr(nkey + 1, 1):= duptype;
keydescr(nkey + 1, 2):= dupaddr;
names(1):= names(3) := insertfile(1);
names(2):= names(4) := insertfile(2);
names(5):= real <::>;
mdsortproc(param, keydescr, names, 0, 0,
result, explanation);
if result > 1 then
begin
write(out, <:<10>***file: :>, names.laf);
case result -1 of
begin
alarm(4, -explanation, <:<10>sortsize:>);
alarm(5, explanation, <:<10>sortdisc:>);
alarm(6, explanation, <:10>sortout:>);
end;
end;
insertfilestate:= -1;
end sort insert;
comment sorting of recover file;
if nrecov > 1 then
begin
i:= varpart + bucksnf;
param(5<*maxrecsize*>):= if i < 22 then 22 else i;
param(6<*noofkeys*>) := 2;
keydescr(1, 1):= keydescr(2, 1):= 2;
keydescr(1, 2):= sort1f;
keydescr(2, 2):= sort2f;
names(1):= names(3):= recoverfile(1);
names(2):= names(4):= recoverfile(2);
names(5):= real<::>;
mdsortproc(param, keydescr, names, 0, 0, result,
explanation);
if result > 1 then
begin
write(out, <:<10>***file: :>, names.laf);
case result - 1 of
begin
alarm(7, -explanation, <:<10>sortsize:>);
alarm(8, explanation, <:<10>sortdisc:>);
alarm(9, explanation, <:<10>sortout:>);
end;
end;
recoverfilestate:= -1;
end sort recov;
end;<*block sort*>
\f
<* recoveri start recovering page ...9/1...
ib, eah, 13.2.79 (22.1.81) *>
comment start recovering phase;
recover:
testout:= testbits shift (-11) extract 1 =1;
if nerrorfile <> 0 then
begin
errorbits:= 1 shift 1;
outwarn(1, 1, nerrorfile);
end
else
if runtype <> 2 then
begin
write(out, <:<10>isq-check ok<10>:>);
if recoverfiles then
begin
i:= 1;
opensq(zrecov, string recoverfile(increase(i)), 0, 2);
closesq(zrecov, true, true);
end;
goto finisdoc;
end;
comment now runtype = 2 or some errors to recover;
if runtype = 2 or
(runtype = 3 and nerrorfile > 0 and nerrorfile < maxerror) then
begin <*recover wanted*>
i:= if shl(bucks) > shl(blocks) then shl(bucks)
else shl(blocks);
if shl(recs) > i then i := shl(recs);
\f
<* recoveri block direct page ...10/1...
ib, eah 13.2.79 *>
begin <*block direct*>
integer swoppos;
zone zfile(i, 1, stderror);
procedure taketable(descr);
integer descr;
begin
integer type;
integer array field inx;
sn(descr):= zrecov.sort1f;
swopfile(descr);
curr(descr):= first(descr);
type:= zrecov.rectypef;
repeat
inx:= curr(descr);
tofrom(zfile.inx, zrecov.varpart, entrysize(descr));
curr(descr):= curr(descr) + entrysize(descr);
inrecover;
until recoverfilestate <> 0 or zrecov.sort1f <> sn(descr);
last(descr):= curr(descr) - entrysize(descr);
end taketable;
procedure swopfile(descr);
integer descr;
begin
if testout then testprint(3, sn(descr), <:swopf:>);
if isqfilestate = -1 then
begin
open(zfile, 4, isqfile, 0);
isqfilestate:= 0;
end;
swoppos:= sn(descr);
setposition(zfile, 0, swoppos);
swoprec6(zfile, shl(descr)*4);
end swopfile;
\f
<* recoveri recovering page ...11/1...
ib, eah 13.2.79 (25.3.81) *>
swopfile(bucks);
zfile.upmf:= 1 shift 2 <*initialize mark*>;
inrecover;
while recoverfilestate = 0 do
begin
if testout then testprint(3, zrecov.rectypef, <:while:>);
case zrecov.rectypef + 1 of
begin
begin <*0, statistics*>
if swoppos <> sn(bucks) then
swopfile(bucks);
lfi:= 4;
zfile.norf:= zrecov.varpart.lfi;
ifi:= lfi +2;
zfile.ubff:= zrecov.varpart.ifi;
lfi:= ifi +4;
zfile.nobf:= zrecov.varpart.lfi;
ifi:= lfi +2;
file_empty:= zrecov.varpart.ifi <> 0;
inrecover;
end;
begin <*1, bucketelement*>
taketable(bucks);
end;
begin <*2, blockelements*>
taketable(blocks);
end;
begin <*3, zerorecs*>
case3:
sn(recs):= zrecov.varpart(1);
swopfile(recs);
for i:= 1 step 1 until shl(recs) do zfile(i):= real<::>;
inrecover;
end;
begin <*4, as 3*>
dissolve:= true;
goto case3;
end;
begin <*5, delete blocktable*>
sn(blocks):= zrecov.varpart(1);
swopfile(blocks);
for i:= 1 step 1 until shl(blocks) do zfile(i):= real <::>;
while recoverfilestate = 0 and zrecov.sort1f = sn(blocks) do
inrecover;
end;
end case;
end while;
<*update buckethead*>
swopfile(bucks);
zfile.upmf:= 0 <*updatemarks cleared*>;
close(zfile, false);
isqfilestate:= -1;
end; <*block direct*>
\f
<* recoveri block isq-update page ...12/1...
ib,eah 12.2.80 *>
i:= 1;
if dissolve then
begin <*block isqupdate*>
integer oks, dups, errs, bufbase;
integer array core(1:400);
zone zisq(buflengthi(string isqfile(increase(i)), true), 3, transfer);
procedure transfer(z, s, b);
zone z; integer s, b;
comment blockprocedure which prints operation and segm.no from used share;
if s extract 1 = 1 <*hard error*> then stderror(z, s, b)
else
begin
getzone6(z, ia);
getshare6(z, ia, ia(17));
write(out, <:<10>trans:>, ia(4) shift (-12), ia(7));
b:= 0;
end transfer;
getzone6(zisq, ia);
bufbase:= ia(14);
open(zisq, 4, isqfile,
testbits shift (-11) extract 1 shift 1);
isqfilestate:= 0;
if file_empty then initfilei (zisq, 1,1)
else startfilei (zisq);
if resulti < 3 then trap(trapl);
if -,file_empty then setupdatei(zisq);
oks:= dups:= errs:= 0;
\f
<* recoveri insert page ...12/2...
ib, eah 12.2.80 *>
comment insert records from insertfile into isqfile;
while ininsert do
begin
if file_empty then
begin
initreci (zisq, zinsert.recpart);
if testout then testprint (11, resulti, <:initreci:>);
i := resulti;
setupdatei (zisq);
file_empty := false;
resulti := case i of (
1, <*ok*>
4, <*file full*>
5, <*rec.length*>
7 <*not ascending key*> );
end
else
begin
insertreci(zisq, zinsert.recpart);
if testout then testprint (11, resulti, <:insertreci:>);
end;
if resulti = 1 then
oks:= oks +1 <*inserted*> else
if resulti = 2 then
dups:= dups +1 else
errs:= errs +1 <*errors*>;
if resulti > 1 then
begin
if testout then testprint (10, resulti, <:inserterror:>);
doclines(2);
write(zdoc, <:<10>**14 insert result :>, case resulti of
(<::>,
<:duplicate: :>,
<:too expensive: :>,
<:file is full: :>,
<:record length: :>,
<:buffer length: :>,
<:key not ascend::>));
docpos:= 33;
docfeed(packedkeysize*4);
docrec(zinsert.recpart);
write(zdoc, <:<10>:>);
end;
end insert;
trapl:
trap(0); <*label may be passed without trapping*>
setreadi(zisq);
close(zisq, false);
isqfilestate:= -1;
doc(1, oks, dups);
if errs > 0 then
begin
errorbits:= 1 shift 1;
outwarn(2, 2, errs);
end;
end; <*block isqupdate*>
end; <*recover wanted*>
end; <*block insertfile*>
\f
<* recoveri finis program page ...13/1...
ib, eah 19.12.79 *>
trapl:
trap(0);
if recoverfilestate <> -1 then
begin
closesq(zrecov, false, false);
if alarmcause <> 0 then
begin
trapmode:= 1 shift 13;
trap(1);
end;
end;
end; <*block check and recover*>
finisdoc:
trap(0);
if docfilestate <> -1 then
begin
write(zdoc, <:<12><25><10>:>);
close(zdoc, false);
end;
taketime;
if testbits shift (-8) extract 1 = 1 then
for i:= 2 step 1 until point do
write(out, <:<10>:>, <<dd>, i -1, << dddd.dd>,
timemea(i, 1) - timemea(i -1, 1), timemea(i, 2) - timemea(i -1, 2));
write(out, <:<10>:>);
end <*block global*>
▶EOF◀