-- CheckCodeImpl.mesa
-- Last edited by Sweet on 22-Aug-83 14:02:53
DIRECTORY
BcdDefs,
BcdOps,
CatchFormat,
Environment,
Exec,
FileName,
FileTransfer,
Format,
Heap,
Mopcodes,
MSegment,
OpTableDefs,
PrincOps,
Stream,
String,
SymbolPack,
Symbols,
SymbolSegment,
SymbolTable,
Table;
CheckCodeImpl: PROGRAM
IMPORTS
mySymbols: SymbolPack, Exec, FileName, FileTransfer, Format,
Heap, MSegment, OpTableDefs, Stream, String =
BEGIN OPEN Symbols;
IgnoreReason: TYPE = {long, old, binder, defs, table, other};
why: ARRAY IgnoreReason OF LONG CARDINAL;
BYTE: TYPE = Environment.Byte;
SymbolHandle: TYPE = LONG POINTER TO FRAME [SymbolPack];
exec: Exec.Handle ← NIL;
conn: FileTransfer.Connection ← NIL;
vfn: FileName.VFN ← NIL;
buffer: LONG POINTER ← NIL;
bufferPages: Environment.PageCount ← 100;
bufferSegment: MSegment.Handle ← NIL;
last: CARDINAL = CARDINAL[bufferPages*Environment.bytesPerPage];
currentDir: LONG STRING ← NIL;
bcd: BcdOps.BcdBase ← NIL;
mtb, sgb, enb: BcdDefs.Base ← NIL;
mth: BcdOps.MTHandle ← NIL;
sgh: BcdOps.SGHandle ← NIL;
symHeader: LONG POINTER TO SymbolSegment.STHeader ← NIL;
codebase: PrincOps.PrefixHandle;
code: LONG POINTER TO PACKED ARRAY [0..0) OF BYTE;
totalFiles, totalBad, totalIgnored: LONG CARDINAL ← 0;
-- 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]};
PutOctal: PROC [n: CARDINAL] = {
Format.Number[execProc, n, [base: 8, zerofill: FALSE, unsigned: TRUE, columns: 1]]};
-- a few procs stolen from SymbolCache
InstallTable: PROC [base: SymbolTable.Base, sym: LONG POINTER] = {
SetBases[base, sym]; base.notifier ← base.NullNotifier};
SetBases: PROC [base: SymbolTable.Base, b: LONG POINTER] = {
tB: Table.Base = LOOPHOLE[b];
p: LONG POINTER TO SymbolSegment.STHeader = b;
q: LONG POINTER TO SymbolSegment.FGHeader;
base.cacheInfo ← NIL;
base.hashVec ← b+p.hvBlock.offset;
base.ht ← DESCRIPTOR[
b+p.htBlock.offset, p.htBlock.size/SIZE[Symbols.HTRecord]];
base.ssb ← b + p.ssBlock.offset;
base.seb ← tB + p.seBlock.offset;
base.ctxb ← tB + p.ctxBlock.offset;
base.mdb ← tB + p.mdBlock.offset;
base.bb ← tB + p.bodyBlock.offset;
base.tb ← tB + p.treeBlock.offset;
base.ltb ← tB + p.litBlock.offset;
base.extb ← tB + p.extBlock.offset;
base.mdLimit ← FIRST[Symbols.MDIndex] + p.mdBlock.size;
base.extLimit ← FIRST[SymbolSegment.ExtIndex] + p.extBlock.size;
base.mainCtx ← p.outerCtx; base.stHandle ← p;
IF p.fgRelPgBase = 0
THEN {base.sourceFile ← NIL; base.fgTable ← NIL}
ELSE {
offset: CARDINAL = LOOPHOLE[
@(NIL[POINTER TO SymbolSegment.FGHeader]).sourceFile];
q ← b + p.fgRelPgBase*Environment.wordsPerPage;
base.sourceFile ← (b + p.fgRelPgBase*Environment.wordsPerPage) + offset;
base.fgTable ← DESCRIPTOR[
b + p.fgRelPgBase*Environment.wordsPerPage + q.offset, q.length]}};
-- end of SymbolPack stuff
Octal4: Format.NumberFormat = [
base: 8, unsigned: TRUE, zerofill: FALSE, columns: 4];
Octal6: Format.NumberFormat = [
base: 8, unsigned: TRUE, zerofill: FALSE, columns: 6];
PutHash: PROC [symbols: SymbolHandle, hti: Symbols.HTIndex] = {
ss: String.SubStringDescriptor;
IF hti = Symbols.HTNull THEN PutString["[Anon]"L]
ELSE {
symbols.ops.SubStringForHash[@ss, hti];
PutSubString[@ss]}};
CheckRemoteCode: Exec.ExecProc = {
ENABLE {
ABORTED => GO TO aborted;
FileTransfer.Error --[code]-- =>
SELECT code FROM
retry => GOTO timedOut;
ENDCASE => GOTO fileTransferProblem;
UNWIND => Finalize[]};
exec ← h;
execProc ← exec.OutputProc[];
Initialize[];
OpenConnection[];
DoChecks[];
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["...FileTransfer problem!"L]}};
Initialize: PROC = {
PutHeading[];
conn ← NIL;
bufferSegment ← MSegment.Create[pages: bufferPages, release: []];
buffer ← MSegment.Address[bufferSegment];
totalFiles ← totalBad ← totalIgnored ← 0;
currentDir ← Heap.systemZone.NEW[StringBody[200]];
why ← ALL[0]};
Finalize: PROC = {
IF bufferSegment # NIL THEN {
MSegment.Delete[bufferSegment]; bufferSegment ← buffer ← NIL};
IF currentDir # NIL THEN Heap.systemZone.FREE[@currentDir];
IF vfn # NIL THEN {FileName.FreeVFN[vfn]; vfn ← NIL};
CloseConnection[]};
PutHeading: PROC = {PutCR[]; PutLine["Remote Code Checker"L]; PutCR[]};
OpenConnection: PROC = {
conn ← FileTransfer.Create[];
conn.SetProcs[clientData: NIL, messages: PutMessages];
};
PutMessages: FileTransfer.MessageProc = {
IF level = fatal THEN {
PutString["FileTransfer 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]}};
CloseConnection: PROC = {
IF conn # NIL THEN {conn.Close[]; conn.Destroy[]; conn ← NIL}};
verbose: BOOLEAN ← FALSE;
DoChecks: PROC = {
token, switches: LONG STRING;
Stats: PROC = {
name: ARRAY IgnoreReason OF STRING = [
long: " too long"L, old: " old bcd version"L, binder: " binder output"L,
defs: " defs"L, table: "table compiled"L, other: " other"L];
PutCR[];
PutCR[];
PutLongDecimal[totalBad];
PutString[" bad files out of "L];
PutLongDecimal[totalFiles];
PutLine[" files"L];
PutLongDecimal[totalIgnored];
PutLine[" were ignored"L];
FOR r: IgnoreReason IN IgnoreReason DO
IF why[r] # 0 THEN {
PutLongDecimal[why[r]];
PutLine[name[r]]};
ENDLOOP;
};
verbose ← FALSE;
DO
ENABLE ABORTED => Stats[];
sense: BOOLEAN ← TRUE;
[token: token, switches: switches] ← exec.GetToken[];
IF token = NIL AND switches = NIL THEN EXIT;
IF switches # NIL THEN FOR n: CARDINAL IN [0..switches.length) DO
SELECT switches[n] FROM
'v, 'V => {verbose ← sense; sense ← TRUE};
'-, '~ => sense ← ~sense;
ENDCASE;
ENDLOOP;
switches ← Exec.FreeTokenString[switches];
IF token # NIL THEN
Check[token ! UNWIND => token ← Exec.FreeTokenString[token]];
token ← Exec.FreeTokenString[token];
ENDLOOP;
Stats[]};
Check: PROC [token: LONG STRING] = {
stream: Stream.Handle ← NIL;
vfn ← FileName.AllocVFN[token];
stream ← conn.ReadStream[vfn, NIL, FALSE, remote];
WHILE stream # NIL DO
ENABLE FileTransfer.Error =>
IF code = skip OR code = spare1 THEN LOOP;
stream.options.signalEndOfStream ← TRUE;
CheckFile[stream];
stream ← FileTransfer.ReadNextStream[stream];
ENDLOOP;
FileName.FreeVFN[vfn]; vfn ← NIL};
CheckFile: PROC [stream: Stream.Handle] = {
source: FileTransfer.FileInfo;
nameShown: BOOLEAN ← FALSE;
problems: BOOLEAN;
Complain: PROC [text: LONG STRING, reason: IgnoreReason] = {
IF verbose THEN {
IF ~nameShown THEN PutString[source.body];
PutLine[text]}
ELSE IF nameShown THEN PutCR[];
totalIgnored ← totalIgnored + 1;
why[reason] ← why[reason] + 1};
BEGIN -- to make Complain visible in EXITS clause
more: BOOLEAN ← TRUE;
IF exec.CheckForAbort[] THEN ERROR ABORTED;
source ← FileTransfer.GetStreamInfo[stream];
IF ~String.EquivalentString[source.directory, currentDir] THEN {
PutLine[source.directory];
currentDir.length ← 0;
String.AppendString[currentDir, source.directory]};
IF (((totalFiles ← totalFiles + 1) MOD 10) = 0) OR verbose THEN {
IF ~verbose THEN {
PutString[" Checking file "L];
PutLongDecimal[totalFiles];
PutString[": "L]};
PutString[source.body];
nameShown ← TRUE};
[] ← stream.GetBlock[
[buffer, 0, last] ! Stream.EndOfStream => {more ← FALSE; CONTINUE}];
IF more THEN GO TO tooLong;
bcd ← LOOPHOLE[buffer, BcdOps.BcdBase];
IF bcd.definitions THEN GO TO defs;
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];
enb ← LOOPHOLE[bcd + bcd.enOffset];
sgh ← @sgb[mth.code.sgi]; -- Bcd's code segment table entry
IF sgh.pages > bufferPages THEN GOTO tooLong;
IF mth.tableCompiled THEN GOTO table;
IF sgh.file # BcdDefs.FTSelf THEN GOTO punt;
codebase ← LOOPHOLE[buffer + (sgh.base - 1)*Environment.wordsPerPage];
codebase ← codebase + mth.code.offset;
code ← LOOPHOLE[codebase];
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;
InstallTable[mySymbols, symHeader];
problems ← ExamineModule[
file: source.body,
nameShown: nameShown,
entries: @enb[mth.entries],
symbols: mySymbols];
IF problems THEN {totalBad ← totalBad + 1; PutCR[]}
ELSE IF nameShown THEN PutCR[];
EXITS
tooLong => {Complain[" too long"L, long]};
obsoleteBcd => {Complain[" obsolete BCD format"L, old]};
binderBcd => {Complain[" binder output"L, binder]};
defs => {Complain[" definitions"L, defs]};
punt => {Complain[" other problem"L, other]};
table => {Complain[" table compiled"L, table]};
badSymbols => {Complain[" bad symbols"L, other]};
END};
-- problem specific stuff
ExamineModule: PROC [
file: LONG STRING, nameShown: BOOLEAN,
entries: BcdOps.ENHandle,
symbols: SymbolHandle]
RETURNS [problems: BOOLEAN ← FALSE] =
BEGIN
catchEV: CatchFormat.CatchEV = LOOPHOLE[codebase.header.catchCode/2];
catchEntry: CatchFormat.CatchEVHandle = @codebase[catchEV];
OneBody: PROC [bti: Symbols.BTIndex] RETURNS [BOOLEAN] = {
start, nBytes: CARDINAL;
WITH b: symbols.bb[bti] SELECT FROM
Callable => IF ~b.inline THEN {
WITH info: b.info SELECT FROM
External => nBytes ← info.bytes;
ENDCASE;
WITH cc: b SELECT FROM
Catch => start ← catchEntry[cc.index];
ENDCASE => start ← entries.initialPC[b.entryIndex];
problems ← problems OR ExamineBody[
start, nBytes, symbols, LOOPHOLE[bti], file, nameShown OR problems]};
ENDCASE;
RETURN[FALSE]};
[] ← symbols.ops.EnumerateBodies[Symbols.RootBti, OneBody];
IF problems THEN PutCR[];
END;
Pair: TYPE = RECORD [fill: BYTE, first, last: [0..16)];
ExamineBody: PROC [
start, nBytes: CARDINAL,
symbols: SymbolHandle, bti: Symbols.CBTIndex,
file: LONG STRING, nameShown: BOOLEAN]
RETURNS [problems: BOOLEAN ← FALSE] = {
catch: BOOLEAN = symbols.bb[bti].nesting = Catch;
inst: BYTE;
il: CARDINAL;
pc: CARDINAL;
none: CARDINAL = CARDINAL.LAST;
rilOffset, rigOffset, linkLoaded: CARDINAL ← none;
offset: CARDINAL;
extra: CARDINAL;
IF catch THEN
IF code[start] = Mopcodes.zJ2 THEN pc ← start + 2
ELSE pc ← start
ELSE pc ← start + 1;
WHILE pc < start + nBytes DO
OPEN Mopcodes;
inst ← code[pc];
BEGIN -- to set up bingo
BEGIN -- to set up checkLocal and checkGlobal
SELECT inst FROM
zRLI00, zRLI01, zRLI02, zRLI03 => {
rilOffset ← 0; rigOffset ← linkLoaded ← none; extra ← 0};
zRLIP, zRLIPF => {
pair: Pair;
extra ← 0;
pair ← LOOPHOLE[code[pc+1]];
rigOffset ← linkLoaded ← none; rilOffset ← pair.first};
zRLILP, zRLILPF => {
pair: Pair;
extra ← 1;
pair ← LOOPHOLE[code[pc+1]];
rigOffset ← linkLoaded ← none; rilOffset ← pair.first};
zRGIP => {
pair: Pair;
extra ← 0;
pair ← LOOPHOLE[code[pc+1]];
rilOffset ← linkLoaded ← none; rigOffset ← pair.first};
zRGILP => {
pair: Pair;
extra ← 1;
pair ← LOOPHOLE[code[pc+1]];
rilOffset ← linkLoaded ← none; rigOffset ← pair.first};
zLLKB => {
linkLoaded ← LOOPHOLE[code[pc+1]];
rilOffset ← rigOffset ← none};
zDUP => IF linkLoaded # none THEN GO TO bingo;
IN [zSLD0..zSLD6] => {offset ← inst - zSLD0; GO TO checkLocal};
zSLD8 => {offset ← 8; GO TO checkLocal};
zSLDB, zPLDB => {offset ← code[pc+1]; GO TO checkLocal};
zPLD0 => {offset ← 0; GO TO checkLocal};
zSGDB => {offset ← code[pc+1]; GO TO checkGlobal};
ENDCASE => rilOffset ← rigOffset ← linkLoaded ← none;
EXITS
checkLocal => {
IF offset >= rilOffset AND offset <= rilOffset + extra THEN
GO TO bingo;
rilOffset ← rigOffset ← linkLoaded ← none};
checkGlobal => {
IF offset >= rigOffset AND offset <= rigOffset + extra THEN
GO TO bingo;
rilOffset ← rigOffset ← linkLoaded ← none};
END;
EXITS
bingo => {
IF ~nameShown THEN PutString[file];
PutString["*****"L];
PutHash[symbols, symbols.ops.HashForSe[symbols.bb[bti].id]];
PutChar['(];
PutOctal[pc];
PutChar[')];
RETURN[TRUE]};
END;
il ← OpTableDefs.InstLength[inst];
IF il = 0 THEN EXIT;
pc ← pc + il;
ENDLOOP;
};
-- User niceness
CheckHelp: Exec.ExecProc = {
h.OutputProc[][
"This command takes all bcds on a remote directory and looks for bad code
CheckRemoteCode.~ remotefilename(/v for verbose)"L]};
-- MAIN BODY CODE
RegisterSelf: PROC = {
Exec.AddCommand[name: "CheckCode.~"L, proc: CheckRemoteCode, help: CheckHelp]};
RegisterSelf[];
END.