// GCK.SR Checking routine
get "BRAVO.DF"
get "HEAP.DF"
// Incoming procedures
external
[
errck
movec;
enfs;
ult;
ugt;
gets;
sbwsize;
getvp;
]
// Incoming statics
external
[
macww
rgdlfirst
rgdllast
macdl
rgmaccp
rgdoc
rgcpfdispl
rgcpfirst
rgcplast
rgul
rgpbm
rghpused
cnrgul
rgfsnew;
vpzone;
mpfnof;
ckperr;
rgnchlast;
vbp;
]
// Outgoing procedures
external
[
ckdir;
]
// C K D I R
//
let ckdir() be
[ (mpfnof ! fndir) >> OF.pos = 0;
let macpos = (mpfnof ! fndir) >> OF.macpos;
let tword = nil;
let type,tsn1,tsn2,tversion,tda,tsbwsize = nil,nil,nil,nil,nil,nil;
let siz = nil;
let tsizsb = nil;
while ult((mpfnof ! fndir) >> OF.pos,macpos) do
[ ckperr = (mpfnof ! fndir) >> OF.pos;
tword = gets(fndir);
type = tword << DIR.type;
siz = tword << DIR.siz;
if type gr 1 then errck("typ");
test type ifnot
(mpfnof ! fndir) >> OF.pos = (mpfnof ! fndir) >> OF.pos+(siz lshift 1)-2
ifso [ tsn1 = gets(fndir);
tsn2 = gets(fndir);
tversion = gets(fndir);
if gets(fndir) ne 0 then errck("unu");
tda = gets(fndir);
tword = gets(fndir);
tsbwsize = sbwsize(lv tword);
if (tsbwsize+(offset DIR.name)/16) ne siz then
errck("siz");
tsizsb = tword << lh;
(mpfnof ! fndir) >> OF.pos = (mpfnof ! fndir) >> OF.pos+(tsbwsize lshift 1)-4;
tword = gets(fndir);
test tsizsb << odd ifso
unless tword << rh eq $. do
errck("n.")
ifnot unless tword eq $. lshift 8 do
errck("n.");
]
]
unless (mpfnof ! fndir) >> OF.pos eq macpos do
errck("mcp");
if macpos << PCD.rc then
[ let vpa = nil;
vpa << VPA.fn = fndir;
vpa << VPA.fp = macpos << PCD.p;
getvp(vpa);
unless macpos << PCD.rc eq rgnchlast ! vbp do errck("lp");
]
]