-- CheckFrames.mesa
-- Last edited by Daniels on 10-Sep-82 15:48:48
-- Last edited by Sweet on 8-Jan-83 19:39:58
DIRECTORY
BcdDefs USING [Base, FTSelf, MTIndex, VersionID],
BcdOps USING [BcdBase, MTHandle, SGHandle],
CatchFormat USING [CatchEV, CatchEVHandle, defaultFsi, nullCatchEV],
Environment USING [Byte, bytesPerPage, PageCount, wordsPerPage],
Exec USING [
AddCommand, CheckForAbort, EndOfCommandLine, ExecProc, FreeTokenString,
GetNameandPassword, GetToken, Handle, OutputProc],
FileTransfer USING [
ClientProc, Close, Connection, Create, Destroy, Error, FileInfo,
GetStreamInfo, MessageProc, ReadNextStream, ReadStream, ResetVFN,
SetPrimaryCredentials, SetProcs, VirtualFilename, VirtualFilenameObject],
Format USING [
Char, CR, Decimal, LongDecimal, Number, NumberFormat, StringProc, SubString],
Heap USING [systemZone],
Mopcodes USING [zJ2],
PrincOps USING [FrameSizeIndex, FrameVec, FSIndex, MaxFrameSize, PrefixHandle],
Profile USING [userName, userPassword],
Space USING [
Create, CreateUniformSwapUnits, Delete, Handle, LongPointer, Map, nullHandle,
virtualMemory],
Storage USING [CopyString],
Stream USING [EndOfStream, GetBlock, Handle],
String USING [InvalidNumber, StringToDecimal, SubString, SubStringDescriptor],
Symbols,
SymbolSegment USING [STHeader, VersionID];
CheckFrames: PROGRAM
IMPORTS
Exec, Heap, FileTransfer, Format, Profile, Space, Storage, Stream, String =
BEGIN OPEN Symbols;
z: UNCOUNTED ZONE ← Heap.systemZone;
BYTE: TYPE = Environment.Byte;
FrameSizeIndex: TYPE = PrincOps.FrameSizeIndex;
exec: Exec.Handle ← NIL;
conn: FileTransfer.Connection ← NIL;
vfn: FileTransfer.VirtualFilename ← @vfnObject;
vfnObject: FileTransfer.VirtualFilenameObject;
buffer: LONG POINTER ← NIL;
bufferPages: Environment.PageCount ← 100;
bufferSpace: Space.Handle ← Space.nullHandle;
last: CARDINAL = bufferPages*Environment.bytesPerPage;
localFsi: FrameSizeIndex ← LAST[FrameSizeIndex];
globalSize: [0..PrincOps.MaxFrameSize] ← PrincOps.MaxFrameSize;
bcd: BcdOps.BcdBase ← NIL;
mtb, sgb: BcdDefs.Base ← NIL;
mth: BcdOps.MTHandle ← NIL;
sgh: BcdOps.SGHandle ← NIL;
symHeader: LONG POINTER TO SymbolSegment.STHeader ← NIL;
ht: LONG POINTER TO ARRAY HTIndex OF HTRecord ← NIL;
ssb: LONG STRING ← NIL;
seb: Symbols.Base ← NIL;
ctxb: Symbols.Base ← NIL;
bb: Symbols.Base ← NIL;
bbSize: CARDINAL ← 0;
bti: Symbols.BTIndex;
codebase: PrincOps.PrefixHandle;
catchEV: CatchFormat.CatchEV;
catchEntry: CatchFormat.CatchEVHandle ← NIL;
FSSequence: TYPE = RECORD [
firstCatch: CARDINAL, seq: SEQUENCE max: CARDINAL OF PrincOps.FSIndex];
frameSizes: LONG POINTER TO FSSequence ← NIL;
countProblems: CARDINAL ← 0;
totalProblems, totalFiles, totalBad: LONG CARDINAL ← 0;
showLocals: BOOLEAN ← FALSE;
-- Exec window output
execProc: Format.StringProc;
PutCR: PROC = {Format.CR[execProc]};
PutString: PROC [s: LONG STRING] = {execProc[s]};
PutSubString: PROC [ss: String.SubString] = {Format.SubString[execProc, ss]};
PutLine: PROC [s: LONG STRING] = {execProc[s]; Format.CR[execProc]};
PutChar: PROC [c: CHARACTER] = {Format.Char[execProc, c]};
PutDecimal: PROC [n: INTEGER] = {Format.Decimal[execProc, n]};
PutLongDecimal: PROC [n: LONG INTEGER] = {Format.LongDecimal[execProc, n]};
PutNumber: PROC [n: INTEGER, f: Format.NumberFormat] = {
Format.Number[execProc, n, f]};
LocalDatum: TYPE = RECORD[
offset, length, nesting: CARDINAL, hti: Symbols.HTIndex];
LocalDataSeq: TYPE = RECORD [length: CARDINAL, data: SEQUENCE maxLength: CARDINAL OF LocalDatum];
LocalData: TYPE = LONG POINTER TO LocalDataSeq;
localData: LocalData ← NIL;
-- a few procs stolen from SymbolPack
FirstCtxSe: PROC [ctx: Symbols.CTXIndex] RETURNS [Symbols.ISEIndex] = {
RETURN [IF ctx = Symbols.CTXNull THEN Symbols.ISENull ELSE ctxb[ctx].seList]};
NextSe: PROC [sei: Symbols.ISEIndex] RETURNS [Symbols.ISEIndex] = {
OPEN Symbols;
RETURN [
IF sei = SENull
THEN ISENull
ELSE
WITH id: seb[sei] SELECT FROM
terminal => ISENull,
sequential => sei + SIZE[sequential id SERecord],
linked => id.link,
ENDCASE => ISENull]};
ArgRecord: PROC [type: CSEIndex] RETURNS [RecordSEIndex] = {
RETURN [IF type = SENull
THEN RecordSENull
ELSE WITH seb[type] SELECT FROM
record => LOOPHOLE[type, RecordSEIndex],
ENDCASE => RecordSENull]};
TransferTypes: PROC [type: SEIndex] RETURNS [typeIn, typeOut: RecordSEIndex] = {
sei: CSEIndex = UnderType[type];
WITH t: seb[sei] SELECT FROM
transfer => RETURN [typeIn: t.inRecord, typeOut: t.outRecord];
ENDCASE;
RETURN [RecordSENull, RecordSENull]};
UnderType: PROC [type: SEIndex] RETURNS [CSEIndex] = {
sei: SEIndex ← type;
WHILE sei # SENull DO
WITH se: seb[sei] SELECT FROM
id => {IF se.idType # typeTYPE THEN ERROR; sei ← se.idInfo};
ENDCASE => EXIT;
ENDLOOP;
RETURN [LOOPHOLE[sei, CSEIndex]]};
-- end of SymbolPack stuff
PutLocals: PROC [root: Symbols.CBTIndex] = {
OPEN Symbols;
in, out: RecordSEIndex;
nesting: CARDINAL ← 0;
AddLocal: PROC [d: LocalDatum] = {
j: CARDINAL;
IF localData.length = localData.maxLength THEN {
new: LocalData ← z.NEW[LocalDataSeq[localData.length + 30]];
FOR i: CARDINAL IN [0..localData.length) DO
new[i] ← localData[i];
ENDLOOP;
new.length ← localData.length;
z.FREE[@localData];
localData ← new};
FOR j ← localData.length, j-1 WHILE j > 0 DO
IF localData[j-1].offset <= d.offset THEN EXIT;
localData[j] ← localData[j-1];
ENDLOOP;
localData[j] ← d;
localData.length ← localData.length + 1};
AddContext: PROC [ctx: Symbols.CTXIndex, nesting: CARDINAL ← 0] = {
FOR sei: Symbols.ISEIndex ← FirstCtxSe[ctx], NextSe[sei] UNTIL sei = Symbols.ISENull DO
IF ~seb[sei].constant THEN AddLocal[[
offset: seb[sei].idValue/16,
length: seb[sei].idInfo/16,
nesting: nesting,
hti: seb[sei].hash]];
ENDLOOP};
EnumerateBodies: PROC [bti: BTIndex, nesting: CARDINAL ← 0] = {
DO
WITH b: bb[bti] SELECT FROM
Callable => WITH bi: b SELECT FROM
Inner => AddLocal[[
offset: bi.frameOffset, length: 1, nesting: nesting,
hti: seb[bi.id].hash]];
ENDCASE;
Other => {
AddContext[b.localCtx, nesting];
IF b.firstSon # BTNull THEN EnumerateBodies[b.firstSon, nesting+1]};
ENDCASE;
IF bb[bti].link.which = parent THEN EXIT;
bti ← bb[bti].link.index;
ENDLOOP};
localData.length ← 0;
[in, out] ← TransferTypes[bb[root].ioType];
IF in # SENull THEN AddContext[seb[in].fieldCtx];
IF out # SENull THEN AddContext[seb[out].fieldCtx];
IF bb[root].localCtx # CTXNull THEN AddContext[bb[root].localCtx];
IF bb[root].firstSon # BTNull THEN EnumerateBodies[bb[root].firstSon];
FOR i: CARDINAL IN [0..localData.length) DO
d: LocalDatum = localData[i];
PutNumber[d.offset, Octal4];
PutNumber[d.length, Octal6];
THROUGH [0..d.nesting] DO PutChar[' ] ENDLOOP;
PutHash[d.hti];
PutCR[];
ENDLOOP;
};
Octal4: Format.NumberFormat = [
base: 8, unsigned: TRUE, zerofill: FALSE, columns: 4];
Octal6: Format.NumberFormat = [
base: 8, unsigned: TRUE, zerofill: FALSE, columns: 6];
PutHash: PROC [hti: Symbols.HTIndex] = {
ss: String.SubStringDescriptor;
SubStringForHash[@ss, hti];
PutSubString[@ss]};
CheckFrames: Exec.ExecProc = {
ENABLE {
ABORTED => GO TO aborted;
FileTransfer.Error --[code]-- =>
SELECT code FROM
login => {LoginUser[clientData: NIL]; RETRY};
retry => GOTO timedOut;
unknown => GOTO fileTransferProblem;
ENDCASE;
UNWIND => Finalize[]};
exec ← h;
execProc ← exec.OutputProc[];
Initialize[];
OpenConnection[];
Check[];
Finalize[];
outcome ← normal;
EXITS
aborted => {outcome ← abort; Finalize[]; PutCR[]; PutLine["...aborted"L]};
timedOut => {
outcome ← error;
Finalize[];
PutCR[];
PutLine["...connection timed out!"L]};
fileTransferProblem => {
outcome ← error;
Finalize[];
PutCR[];
PutLine["...unknown FileTransfer problem!"L]}};
Initialize: PROC = {
PutHeading[];
localFsi ← LAST[FrameSizeIndex];
globalSize ← PrincOps.MaxFrameSize;
conn ← NIL;
vfnObject ← FileTransfer.VirtualFilenameObject[
host: NIL, directory: NIL, name: NIL, version: NIL];
vfn ← @vfnObject;
bufferSpace ← Space.Create[size: bufferPages, parent: Space.virtualMemory];
totalFiles ← totalProblems ← totalBad ← 0;
Space.Map[bufferSpace];
Space.CreateUniformSwapUnits[parent: bufferSpace, size: 4];
buffer ← Space.LongPointer[bufferSpace];
localData ← z.NEW[LocalDataSeq[100]]};
Finalize: PROC = {
IF bufferSpace # Space.nullHandle THEN {
Space.Delete[bufferSpace]; bufferSpace ← Space.nullHandle; buffer ← NIL};
IF localData # NIL THEN z.FREE[@localData];
IF frameSizes # NIL THEN Heap.systemZone.FREE[@frameSizes];
FileTransfer.ResetVFN[vfn: vfn, h: TRUE, d: TRUE, n: TRUE, v: TRUE];
CloseConnection[]};
PutHeading: PROC = {PutCR[]; PutLine["Frame Size Checker"L]; PutCR[]};
OpenConnection: PROC = {
conn ← FileTransfer.Create[];
conn.SetProcs[clientData: NIL, messages: PutMessages, login: LoginUser];
conn.SetPrimaryCredentials[
user: Profile.userName, password: Profile.userPassword];
};
PutMessages: FileTransfer.MessageProc = {
IF level = fatal THEN {
PutString["Fatal error: "L];
IF s1 # NIL THEN PutString[s1];
IF s2 # NIL THEN PutString[s2];
IF s3 # NIL THEN PutString[s3];
IF s4 # NIL THEN PutString[s4]}};
LoginUser: FileTransfer.ClientProc --[clientData: LONG POINTER]-- = {
user: STRING = [40];
password: STRING = [40];
exec.GetNameandPassword[user, password];
conn.SetPrimaryCredentials[user: user, password: password]};
CloseConnection: PROC = {
IF conn # NIL THEN {conn.Close[]; conn.Destroy[]; conn ← NIL}};
verbose: BOOLEAN ← FALSE;
Check: PROC = {
ENABLE FileTransfer.Error => IF code = skip THEN CONTINUE;
stream: Stream.Handle ← NIL;
token, switches: LONG STRING;
FileTransfer.ResetVFN[vfn: vfn, h: TRUE, d: TRUE, n: TRUE, v: FALSE];
[token: token, switches: switches] ← exec.GetToken[];
vfn.host ← Storage.CopyString[token];
[] ← Exec.FreeTokenString[token];
[] ← Exec.FreeTokenString[switches];
[token: token, switches: switches] ← exec.GetToken[];
vfn.directory ← Storage.CopyString[token];
verbose ← FALSE;
IF switches # NIL AND switches.length # 0 THEN
FOR n: CARDINAL IN [0..switches.length) DO
SELECT switches[n] FROM
'v, 'V => verbose ← TRUE;
'a, 'A => showLocals ← TRUE;
ENDCASE;
ENDLOOP;
[] ← Exec.FreeTokenString[token];
[] ← Exec.FreeTokenString[switches];
vfn.name ← Storage.CopyString["*.bcd"L];
UNTIL exec.EndOfCommandLine[] DO
valid: BOOLEAN ← TRUE;
num: CARDINAL;
[token, switches] ← exec.GetToken[];
IF token # NIL THEN
num ← String.StringToDecimal[
token ! String.InvalidNumber => {valid ← FALSE; CONTINUE}];
IF valid AND switches # NIL AND switches.length # 0 THEN
SELECT switches[0] FROM
'l, 'L => localFsi ← GetFsi[num];
'g, 'G => globalSize ← num;
ENDCASE;
[] ← Exec.FreeTokenString[token];
[] ← Exec.FreeTokenString[switches];
ENDLOOP;
PutString["Checking for local frames >= "L];
PutDecimal[PrincOps.FrameVec[localFsi]];
PutString[", global frames >= "L];
PutDecimal[globalSize];
PutLine["..."L];
stream ← conn.ReadStream[vfn, NIL, FALSE, remote];
WHILE stream # NIL DO
stream.options.signalEndOfStream ← TRUE;
CheckFile[stream];
stream ← FileTransfer.ReadNextStream[stream]
ENDLOOP;
FileTransfer.ResetVFN[vfn: vfn, h: TRUE, d: TRUE, n: TRUE, v: TRUE];
PutCR[];
PutCR[];
PutLongDecimal[totalBad];
PutString[" files out of "L];
PutLongDecimal[totalFiles];
PutString[" had "L];
PutLongDecimal[totalProblems];
PutLine[" problems"L]};
CheckFile: PROC [stream: Stream.Handle] = {
source: FileTransfer.FileInfo;
tooLong: BOOLEAN ← TRUE;
IF exec.CheckForAbort[] THEN ERROR ABORTED;
source ← FileTransfer.GetStreamInfo[stream];
IF (((totalFiles ← totalFiles + 1) MOD 10) = 0) OR verbose THEN {
IF ~verbose THEN {
PutString[" Checking file "L];
PutLongDecimal[totalFiles];
PutString[": "L]};
PutLine[source.body]};
[] ← stream.GetBlock[
[buffer, 0, last] ! Stream.EndOfStream => {tooLong ← FALSE; CONTINUE}];
IF ~tooLong THEN {
bcd ← LOOPHOLE[buffer, BcdOps.BcdBase];
IF bcd.versionIdent # BcdDefs.VersionID THEN GOTO obsoleteBcd;
IF bcd.nConfigs # 0 THEN GOTO binderBcd;
IF bcd.nPages > bufferPages THEN GOTO tooLong;
mtb ← LOOPHOLE[bcd + bcd.mtOffset];
mth ← @mtb[FIRST[BcdDefs.MTIndex]];
sgb ← LOOPHOLE[bcd + bcd.sgOffset];
sgh ← @sgb[mth.code.sgi]; -- Bcd's code segment table entry
IF sgh.pages > bufferPages THEN GOTO tooLong;
IF mth.tableCompiled OR sgh.file # BcdDefs.FTSelf THEN GOTO punt; -- tablecompiled, or ...
codebase ← LOOPHOLE[buffer + (sgh.base - 1)*Environment.wordsPerPage];
codebase ← codebase + mth.code.offset;
catchEV ← LOOPHOLE[codebase.entry[codebase.header.nEntries]/2];
catchEntry ← @codebase[catchEV];
sgh ← @sgb[mth.sseg]; -- Bcd's symbol segment table entry
IF sgh.base + sgh.pages > bufferPages THEN GOTO tooLong;
IF sgh.file # BcdDefs.FTSelf THEN GOTO punt; -- tablecompiled, or ...
symHeader ← LOOPHOLE[buffer + (sgh.base - 1)*Environment.wordsPerPage];
IF symHeader.versionIdent # SymbolSegment.VersionID THEN GOTO badSymbols;
bb ← LOOPHOLE[symHeader + symHeader.bodyBlock.offset];
IF (bbSize ← symHeader.bodyBlock.size) = 0 THEN GOTO punt;
ht ← LOOPHOLE[symHeader + symHeader.htBlock.offset];
ssb ← LOOPHOLE[symHeader + symHeader.ssBlock.offset];
seb ← LOOPHOLE[symHeader + symHeader.seBlock.offset];
ctxb ← LOOPHOLE[symHeader + symHeader.ctxBlock.offset];
IF symHeader.seBlock.size = 0 THEN GOTO punt;
GetFrameSizes[];
bti ← FIRST[Symbols.BTIndex];
countProblems ← 0;
IF mth.framesize >= globalSize THEN {
IF verbose THEN PutString[" "L]
ELSE {PutString[source.body]; PutString[", "L]};
PutString["gf size = "L];
PutDecimal[mth.framesize];
PutCR[];
countProblems ← 1};
UNTIL LOOPHOLE[bti, CARDINAL] >= bbSize DO
ok: BOOLEAN;
ss: String.SubStringDescriptor;
WITH b: bb[bti] SELECT FROM
Callable => {
WITH bi: b.info SELECT FROM
External => ok ← ~b.inline;
ENDCASE => ok ← FALSE;
IF ok THEN
WITH b SELECT FROM
Outer, Inner =>
IF frameSizes[b.entryIndex] > localFsi THEN {
IF countProblems = 0 AND ~verbose THEN PutLine[source.body];
countProblems ← countProblems + 1;
IF b.entryIndex = 0 THEN ss ← ["MAIN"L, 0, ("MAIN"L).length]
ELSE SubStringForHash[@ss, seb[b.id].hash];
PutString[" "];
PutSubString[@ss];
PutString[", frame size = "];
PutDecimal[PrincOps.FrameVec[frameSizes[b.entryIndex]]];
PutCR[];
IF showLocals THEN PutLocals[LOOPHOLE[bti]]};
Catch => {
IF catchEV = CatchFormat.nullCatchEV THEN GOTO punt;
IF frameSizes[index + frameSizes.firstCatch] > localFsi THEN {
IF countProblems = 0 AND ~verbose THEN PutLine[source.body];
countProblems ← countProblems + 1;
PutString[" CATCH["L];
PutDecimal[index];
PutString["], frame size = "L];
PutDecimal[
PrincOps.FrameVec[
frameSizes[index + frameSizes.firstCatch]]];
PutCR[]}};
ENDCASE;
WITH b SELECT FROM
Outer => bti ← bti + SIZE[Outer Callable BodyRecord];
Inner => bti ← bti + SIZE[Inner Callable BodyRecord];
Catch => bti ← bti + SIZE[Catch Callable BodyRecord];
ENDCASE};
Other => bti ← bti + SIZE[Other BodyRecord];
ENDCASE;
ENDLOOP;
IF frameSizes # NIL THEN Heap.systemZone.FREE[@frameSizes];
IF countProblems # 0 THEN {
totalProblems ← totalProblems + countProblems; totalBad ← totalBad + 1}};
EXITS
tooLong => {};
obsoleteBcd => {};
binderBcd => {};
punt => {};
badSymbols => {}};
GetFsi: PROC [frameSize: CARDINAL] RETURNS [FrameSizeIndex] = {
FOR fsi: FrameSizeIndex DECREASING IN FrameSizeIndex DO
IF frameSize >= PrincOps.FrameVec[fsi] THEN RETURN[fsi];
REPEAT FINISHED => RETURN[0]
ENDLOOP};
GetFrameSizes: PROC = {
nEntries: CARDINAL = codebase.header.nEntries;
code: LONG POINTER TO PACKED ARRAY [0..0) OF BYTE = LOOPHOLE[codebase];
frameSizes ← Heap.systemZone.NEW[
FSSequence [nEntries + catchEntry.count] ← [
firstCatch: nEntries, seq: NULL]];
FOR i: CARDINAL IN [0..nEntries) DO
frameSizes[i] ← code[codebase.entry[i].pc] ENDLOOP;
IF catchEV # CatchFormat.nullCatchEV THEN
FOR i: CARDINAL IN [0..catchEntry.count) DO
frameSizes[i + frameSizes.firstCatch] ←
IF code[catchEntry[i]] = Mopcodes.zJ2 THEN code[catchEntry[i] + 1]
ELSE CatchFormat.defaultFsi;
ENDLOOP;
};
SubStringForHash: PROC [s: String.SubString, hti: HTIndex] = {
s.base ← ssb;
IF hti = HTNull THEN s.offset ← s.length ← 0
ELSE s.length ← ht[hti].ssIndex - (s.offset ← ht[hti - 1].ssIndex)};
-- User niceness
CheckHelp: Exec.ExecProc = {
h.OutputProc[][
"This command takes all bcds on a remote directory and looks for procedures with a local frame size greater than some given size. It can also do the same for global frames. The command line format is
CheckFrames.~ host dir localSize/l globalSize/g"L]};
-- MAIN BODY CODE
RegisterSelf: PROC = {
Exec.AddCommand[name: "CheckFrames.~"L, proc: CheckFrames, help: CheckHelp]};
RegisterSelf[];
END.