MimosaLogImpl.mesa
Copyright Ó 1985, 1986, 1987, 1988, 1991, 1992 by Xerox Corporation. All rights reserved.
Satterthwaite, June 25, 1986 9:40:06 am PDT
Russ Atkinson (RRA) October 21, 1988 11:27:01 am PDT
DIRECTORY
Ascii USING [CR, FF, LF, SP],
CompilerUtil USING [AcquireStream, ReleaseStream],
ConvertUnsafe USING [SubString],
IO USING [EndOfStream, Error, GetChar, Put, Put1, PutChar, PutF, PutF1, PutRope, SetIndex, STREAM, Value],
Literals USING [LitClass, LTIndex, STIndex],
LiteralOps USING [IsShort, StringValue, Value, ValueBits, ValueInt, ValueReal],
MessageTab USING [ApplName, ErrorMessages, FApplName, FnName, OpName],
MimData USING [bodyIndex, cedar, nErrors, nWarnings, ownSymbols, switches, textIndex],
MimosaLog USING [ErrorCode, Type],
Rope USING [ROPE],
SourceMap USING [nullLoc],
SymbolOps USING [CtxEntries, FirstCtxSe, NextSe, NormalType, STB, SubStringForName],
Symbols USING [BTNull, CSEIndex, CTXIndex, ISEIndex, ISENull, Name, nullName, nullType, TransferMode, Type],
SymbolTable USING [Base],
SymbolTablePrivate USING [SymbolTableBaseRep],
Tree USING [Base, Index, Link, NodeName, NodePtr, Null, Scan],
TreeOps USING [GetLit, GetTag, ScanList];
MimosaLogImpl: PROGRAM
IMPORTS CompilerUtil, IO, LiteralOps, MessageTab, MimData, SymbolOps, TreeOps
EXPORTS MimosaLog, SourceMap, SymbolTable = {
OPEN Symbols;
ROPE: TYPE = Rope.ROPE;
STB: TYPE = REF SymbolTableBaseRep;
SymbolTableBaseRep: PUBLIC TYPE = SymbolTablePrivate.SymbolTableBaseRep;
ErrorCode: TYPE = MimosaLog.ErrorCode;
FileByteIndex: TYPE = INT;
source location encoding
Loc: PUBLIC TYPE = CARD;
nullLoc: Loc = SourceMap.nullLoc;
Init: PUBLIC PROC = {};
Reset: PUBLIC PROC = {};
Cons: PUBLIC PROC [index: INT] RETURNS [loc: Loc] = {
IF index < 0 THEN RETURN [SourceMap.nullLoc];
RETURN [LOOPHOLE[index]];
};
Val: PUBLIC PROC [loc: Loc] RETURNS [index: INT] = {
RETURN [LOOPHOLE[loc]];
};
public interface
Error: PUBLIC PROC [code: ErrorCode] = {
Enter[];
WriteErrorString[code];
ErrorLog[TRUE];
Exit[];
};
ErrorHti: PUBLIC PROC [code: ErrorCode, name: Name] = {
ErrorTree[code, [hash[name]]];
};
ErrorN: PUBLIC PROC [code: ErrorCode, n: INTEGER] = {
Enter[];
errorStream.Put1[[integer[n]]];
errorStream.PutChar[' ];
WriteErrorString[code];
ErrorLog[TRUE];
Exit[];
};
ErrorNode: PUBLIC PROC [code: ErrorCode, node: Tree.Index] = {
ErrorTree[code, [subtree[node]]];
};
ErrorNodeOp: PUBLIC PROC [code: ErrorCode, node: Tree.Index, op: Tree.NodeName] = {
ErrorTreeOp[code, [subtree[node]], op];
};
ErrorSei: PUBLIC PROC [code: ErrorCode, sei: ISEIndex] = {
ErrorTree[code, [symbol[sei]]];
};
ErrorRope: PUBLIC PROC [code: ErrorCode, r: ROPE] = {
Enter[];
IO.PutRope[errorStream, r];
ErrorLog[TRUE];
Exit[];
};
ErrorTree: PUBLIC PROC [code: ErrorCode, t: Tree.Link] = {
Enter[];
PrintOperand[t, 0, 0];
errorStream.PutRope[" "];
WriteErrorString[code];
ErrorLog[TRUE];
Exit[];
};
ErrorTreeOp: PUBLIC PROC [code: ErrorCode, t: Tree.Link, op: Tree.NodeName] = {
Enter[];
PrintOperand[t, 0, 0];
errorStream.PutRope[" "];
WriteErrorString[code];
PrintOperator[op];
errorStream.PutRope[" operation"];
ErrorLog[TRUE];
Exit[];
};
ErrorType: PUBLIC PROC [code: ErrorCode, t: Tree.Link, type: MimosaLog.Type] = {
Enter[];
PrintOperand[t, 0, 0];
errorStream.PutRope[" "];
WriteErrorString[code];
PrintType[type];
ErrorLog[TRUE];
Exit[];
};
Warning: PUBLIC PROC [code: ErrorCode] = {
IF MimData.switches['w] THEN {
Enter[];
errorStream.PutRope["warning: "];
WriteErrorString[code]; ErrorLog[FALSE];
Exit[];
};
};
WarningNode: PUBLIC PROC [code: ErrorCode, node: Tree.Index] = {
WarningTree[code, [subtree[node]]];
};
WarningSei: PUBLIC PROC [code: ErrorCode, sei: ISEIndex] = {
WarningTree[code, [symbol[sei]]];
};
WarningSubString: PUBLIC PROC [code: ErrorCode, s: ConvertUnsafe.SubString] = {
IF MimData.switches['w] THEN {
Enter[];
WriteSubString[s];
errorStream.PutChar[' ];
WriteErrorString[code];
ErrorLog[FALSE];
Exit[];
}
};
WarningRope: PUBLIC PROC [code: ErrorCode, s: ROPE] = {
IF MimData.switches['w] THEN {
Enter[];
errorStream.Put[[rope[s]], [character[' ]]];
WriteErrorString[code];
ErrorLog[FALSE];
Exit[];
}
};
WarningTree: PUBLIC PROC [code: ErrorCode, t: Tree.Link] = {
IF MimData.switches['w] THEN {
Enter[];
errorStream.PutRope["warning: "];
PrintOperand[t, 0, 0];
errorStream.PutRope[" "];
WriteErrorString[code];
ErrorLog[FALSE];
Exit[];
}
};
source printing
PrintTextLine: PROC [i: Loc] = {
RRA: make sure that this routine essentially matches MimScanner.ErrorContext
sourceStream: IO.STREAM = CompilerUtil.AcquireStream[$source];
start: FileByteIndex ¬ Val[i];
lineIndex: FileByteIndex ¬ start;
{
ENABLE IO.Error, IO.EndOfStream => GO TO flakeOut;
FOR n: [1..100] IN [1..100] UNTIL lineIndex = 0 DO
lineIndex ¬ lineIndex - 1;
IO.SetIndex[sourceStream, lineIndex];
SELECT sourceStream.GetChar[] FROM
Ascii.CR, Ascii.FF, Ascii.LF => EXIT;
ENDCASE;
start ¬ lineIndex;
ENDLOOP;
IO.SetIndex[sourceStream, start];
FOR n: [1..100] IN [1..100] DO
char: CHAR ¬ IO.GetChar[sourceStream ! IO.EndOfStream => EXIT];
SELECT char FROM
Ascii.CR, Ascii.FF, Ascii.LF => EXIT;
ENDCASE => IO.PutChar[errorStream, char];
ENDLOOP;
IO.PutChar[errorStream, '\n];
EXITS flakeOut =>
IO.PutRope[errorStream,
"<<Illegal source position. Perhaps this is from an imported INLINE?>>\n"];
};
CompilerUtil.ReleaseStream[$source];
};
errorStream is set by Enter
errorStream: IO.STREAM ¬ NIL;
debug: BOOL ¬ FALSE;
EnterSignal: SIGNAL = CODE;
Enter: PROC = {
errorStream ¬ CompilerUtil.AcquireStream[$log];
IF debug THEN SIGNAL EnterSignal;
};
Exit: PROC = {
CompilerUtil.ReleaseStream[$log];
errorStream ¬ NIL;
};
WriteSubString: PROC [s: ConvertUnsafe.SubString] = {
FOR i: CARDINAL IN [s.offset .. s.offset+s.length) DO
errorStream.PutChar[s.base[i]]
ENDLOOP
};
WriteId: PROC [stb: SymbolTable.Base, name: Name] = {
IF name # nullName THEN {
s: ConvertUnsafe.SubString ¬ SymbolOps.SubStringForName[stb, name];
WriteSubString[s];
}
};
WriteErrorString: PROC [n: ErrorCode] = INLINE {
IO.PutRope[errorStream, MessageTab.ErrorMessages[n]];
};
WriteName: PROC [name: Name] = {
IF name = nullName
THEN errorStream.PutRope["(anonymous)"]
ELSE WriteId[MimData.ownSymbols, name];
};
WriteSei: PROC [sei: ISEIndex] = {
stb: STB ¬ MimData.ownSymbols;
WriteName[IF sei = ISENull
THEN nullName
ELSE stb.seb[sei].hash]
};
WriteLti: PROC [lti: Literals.LTIndex] = {
IF LiteralOps.IsShort[lti]
THEN {
class: Literals.LitClass ¬ LiteralOps.Value[lti].class;
bits: CARD ¬ LiteralOps.ValueBits[lti];
IF debug
THEN
When debugging we put out extra information to the stream to identify literals.
SELECT class FROM
unsigned =>
errorStream.PutF1["lit[unsigned: %g]", [cardinal[bits]] ];
signed =>
errorStream.PutF1["lit[signed: %g]", [integer[LiteralOps.ValueInt[lti]]] ];
either =>
errorStream.PutF1["lit[either: %g]", [cardinal[bits]] ];
real =>
errorStream.PutF1["lit[real: %g]", [real[LiteralOps.ValueReal[lti]]] ];
bits =>
errorStream.PutF1["lit[bits: %bB]", [cardinal[bits]] ];
ENDCASE =>
errorStream.PutF1["lit[unknown: %bB]", [cardinal[bits]] ]
ELSE
SELECT class FROM
unsigned => errorStream.PutF1["%g", [cardinal[bits]] ];
signed => errorStream.PutF1["%g", [integer[LiteralOps.ValueInt[lti]]] ];
either => errorStream.PutF1["%g", [cardinal[bits]] ];
real => errorStream.PutF1["%g", [real[LiteralOps.ValueReal[lti]]] ];
bits => errorStream.PutF1["%bB", [cardinal[bits]] ];
ENDCASE => errorStream.PutF1["%bB", [cardinal[bits]] ];
}
ELSE errorStream.PutRope["--long literal--"];
};
WriteSti: PROC [sti: Literals.STIndex] = {
s: LONG STRING = LiteralOps.StringValue[sti];
errorStream.PutChar['"];
FOR i: CARDINAL IN [0..s.length) DO
c: CHAR ¬ s[i];
SELECT c FROM
'\" => {errorStream.PutChar['\\]; errorStream.PutChar[c]};
'\n => {errorStream.PutChar['\\]; errorStream.PutChar['n]};
IN [40C..176C] => errorStream.PutChar[c];
ENDCASE => {
errorStream.PutChar['\\];
errorStream.PutChar['0 + ORD[c] / 100B];
errorStream.PutChar['0 + (ORD[c] MOD 100B) / 10B];
errorStream.PutChar['0 + ORD[c] MOD 10B];
};
ENDLOOP;
errorStream.PutChar['"];
};
tables used for printing trees (pending reordering of node names)
OpPrec: ARRAY Tree.NodeName[$assignx..$uparrow] OF CARDINAL = [
1, 1,
2, 3, 5, 5, 5, 5, 5, 5, 5, 5,
6, 6, 7, 7, 7, 8,
11, 11, 11,
1, 4, 9, 10, 11];
WriteOpName: PROC [n: Tree.NodeName[$assignx..$uparrow]] = INLINE {
IO.PutRope[errorStream, MessageTab.OpName[n]];
};
WriteFnName: PROC [n: Tree.NodeName[$min..$new]] = INLINE {
IO.PutRope[errorStream, MessageTab.FnName[n]];
};
WriteApplName: PROC [n: Tree.NodeName[$apply..$joinx]] = INLINE {
IO.PutRope[errorStream, MessageTab.ApplName[n]];
};
WriteFApplName: PROC [n: Tree.NodeName[$restart..$broadcast]] = INLINE {
IO.PutRope[errorStream, MessageTab.FApplName[n]];
};
PrintOperator: PROC [op: Tree.NodeName] = {
SELECT op FROM
IN Tree.NodeName[$apply..$joinx] => WriteApplName[op];
IN Tree.NodeName[$assignx..$uparrow] => WriteOpName[op];
IN Tree.NodeName[$min..$new] => WriteFnName[op];
IN Tree.NodeName[$restart..$broadcast] => WriteFApplName[op];
call => WriteApplName[callx];
signal => WriteApplName[signalx];
error => WriteApplName[errorx];
syserror => WriteApplName[syserrorx];
xerror => WriteApplName[errorx];
start => WriteApplName[startx];
join => WriteApplName[joinx];
assign, extract => WriteOpName[assignx];
ENDCASE => errorStream.PutRope["..."];
};
Cutoff: CARDINAL = 3;
PrintOperand: PROC [t: Tree.Link, tPrec, depth: CARDINAL] = {
IF t = Tree.Null THEN RETURN;
WITH e: t SELECT TreeOps.GetTag[t] FROM
hash => WriteName[e.index];
symbol => WriteSei[e.index];
literal => WriteLti[e.index];
string => WriteSti[e.index];
subtree => {
node: Tree.Index = e.index;
stb: STB = MimData.ownSymbols;
tb: Tree.Base = stb.tb;
tp: Tree.NodePtr = @tb[node];
op: Tree.NodeName = tp.name;
IF depth > Cutoff THEN {errorStream.PutRope["..."]; RETURN};
SELECT op FROM
syserror, syserrorx => errorStream.PutRope["ERROR"];
first, last, pred, succ, length, base, nil, ord => {
IF tp.son[1] # Tree.Null THEN {
PrintOperand[tp.son[1], OpPrec[dot], depth+1];
errorStream.PutChar['.];
};
WriteFnName[op];
};
call, portcall, signal, error, syserror, xerror, start, join, apply, callx, portcallx, signalx, errorx, syserrorx, startx, fork, joinx, index, dindex, seqindex, reloc, construct, union, rowcons, stringinit, min, max, abs, all, size, first, last, pred, succ, arraydesc, length, base, loophole, val => {
args: Tree.Link ¬ Tree.Null;
SELECT op FROM
IN [call .. rowcons], stringinit => {
IF tp.son[1] # Tree.Null THEN PrintOperand[tp.son[1], 0, depth];
args ¬ tp.son[2];
};
size => {
Funny name based on subInfo
(see Pass1T & Pass4Xc for details)
name: ROPE ¬ "SIZE??";
SELECT tp.subInfo FROM
1 => name ¬ "BITS";
2 => name ¬ "BYTES";
3 => name ¬ "SIZE";
4 => name ¬ "WORDS";
5 => name ¬ "UNITS"; -- reserved for now, but not used
ENDCASE;
args ¬ tp.son[1];
};
IN [min .. loophole] => {WriteFnName[op]; args ¬ tp.son[1]};
ENDCASE;
IF args # Tree.Null OR op # nil THEN {
errorStream.PutChar['[];
IF depth = Cutoff AND TreeOps.GetTag[args] = subtree
THEN errorStream.PutRope["..."]
ELSE PrintOperandList[args, depth+1];
IF op IN [call .. joinx] AND tp.nSons > 2 THEN
errorStream.PutRope[" !..."];
errorStream.PutChar[']];
};
};
assignx, extractx, or, and, relE, relN, relL, relGE, relG, relLE, in, notin, plus, minus, times, div, mod, power, dot, cdot, dollar, create, not, uminus, addr, uparrow => {
prec: CARDINAL = OpPrec[op];
IF prec < tPrec THEN errorStream.PutChar['(];
SELECT op FROM
IN [create .. addr] => {
WriteOpName[op];
PrintOperand[tp.son[1], prec, depth];
};
IN [assignx .. dollar] => {
PrintOperand[tp.son[1], prec, depth+1];
WriteOpName[op];
PrintOperand[tp.son[2], prec+1, depth+1];
};
uparrow => {
PrintOperand[tp.son[1], prec, depth];
errorStream.PutChar['^];
};
ENDCASE => errorStream.PutChar['?];
IF prec < tPrec THEN errorStream.PutChar[')];
};
intOO, intOC, intCO, intCC => {
errorStream.PutChar[IF op = intOO OR op = intOC THEN '( ELSE '[];
PrintOperand[tp.son[1], 0, depth];
errorStream.PutRope[".."];
PrintOperand[tp.son[2], 0, depth];
errorStream.PutChar[IF op = intOO OR op = intCO THEN ') ELSE ']];
};
clit => {
c: CHAR = VAL[CARDINAL[LiteralOps.ValueBits[TreeOps.GetLit[tp.son[1]]]]];
errorStream.PutChar[''];
IF c >= Ascii.SP
THEN errorStream.PutChar[c]
ELSE {errorStream.PutF1["\\%3b", [cardinal[c.ORD]]]};
};
new, cons, listcons => {
IF tp.son[1] # Tree.Null THEN {
PrintOperand[tp.son[1], OpPrec[dot], depth+1];
errorStream.PutChar['.];
};
errorStream.PutRope[
SELECT op FROM new => "NEW[", cons => "CONS[", ENDCASE => "LIST["];
IF depth = Cutoff
THEN errorStream.PutRope["..."]
ELSE PrintOperandList[tp.son[2], depth+1];
errorStream.PutChar[']];
};
atom => {
errorStream.PutChar['$];
WITH e1: tp.son[1] SELECT TreeOps.GetTag[tp.son[1]] FROM
hash => WriteName[e1.index];
ENDCASE;
};
lengthen, shorten, llit, cast, check, float, pad, chop, safen, syscallx, narrow, istype, openx, thread =>
PrintOperand[tp.son[1], tPrec, depth];
item => PrintOperand[tp.son[2], tPrec, depth];
ENDCASE => errorStream.PutRope["..."];
};
ENDCASE;
};
PrintOperandList: PROC [t: Tree.Link, depth: CARDINAL] = {
firstSon: BOOL ¬ TRUE;
PrintItem: Tree.Scan = {
IF ~firstSon THEN errorStream.PutRope[", "];
firstSon ¬ FALSE;
IF t # Tree.Null THEN PrintOperand[t, 0, depth];
};
TreeOps.ScanList[t, PrintItem];
};
PrintType: PROC [root: MimosaLog.Type] = {
seb: Tree.Base ¬ root.stb.seb;
ItemPrinter: TYPE = PROC [sei: ISEIndex, depth: NAT];
PrintSei: ItemPrinter = {WriteId[root.stb, seb[sei].hash]};
PrintField: ItemPrinter = {
prefix: ROPE ¬ NIL;
IF seb[sei].hash # nullName THEN {
WriteId[root.stb, seb[sei].hash];
prefix ¬ ": ";
};
PrintTypeExp[prefix, seb[sei].idType, depth];
};
PrintCtxItems: PROC [ctx: CTXIndex, printer: ItemPrinter, depth: NAT] = {
nItems: CARDINAL = SymbolOps.CtxEntries[root.stb, ctx];
maxItems: CARDINAL = MIN[nItems, 4/(depth+1)];
n: CARDINAL ¬ 0;
FOR sei: ISEIndex ¬ SymbolOps.FirstCtxSe[root.stb, ctx], SymbolOps.NextSe[root.stb, sei]
UNTIL n = maxItems DO
IF n # 0 THEN errorStream.PutRope[", "];
printer[sei, depth+1];
n ¬ n + 1;
ENDLOOP;
IF nItems > maxItems THEN {
IF n > 0 THEN errorStream.PutRope[", "];
errorStream.PutRope["..."]};
};
PrintTypeExp: PROC [prefix: ROPE, type: Symbols.Type, depth: NAT] = {
IF prefix # NIL THEN IO.PutRope[errorStream, prefix];
IF depth <= Cutoff THEN
WITH t: seb[type] SELECT FROM
id => WriteId[root.stb, t.hash];
cons =>
WITH s: t SELECT FROM
mode => errorStream.PutRope["TYPE"];
enumerated => {
errorStream.PutChar['{];
PrintCtxItems[s.valueCtx, PrintSei, depth];
errorStream.PutChar['}];
};
record => {
IF ~s.argument THEN errorStream.PutRope["RECORD"];
errorStream.PutChar['[];
PrintCtxItems[s.fieldCtx, PrintField, depth];
errorStream.PutChar[']];
};
ref => {
prefix: ROPE ¬ NIL;
SELECT TRUE FROM
s.var =>
IF s.readOnly THEN prefix ¬ "READONLY " ELSE prefix ¬ "VAR ";
s.counted =>
IF s.readOnly THEN prefix ¬ "REF READONLY " ELSE prefix ¬ "REF ";
s.readOnly =>
prefix ¬ "POINTER TO READONLY ";
ENDCASE =>
prefix ¬ "POINTER TO ";
PrintTypeExp[prefix, s.refType, depth+1];
};
array => {
IF s.packed THEN errorStream.PutRope["PACKED "];
PrintTypeExp["ARRAY ", s.indexType, depth+1];
PrintTypeExp[" OF ", s.componentType, depth+1];
};
arraydesc => {
PrintTypeExp["DESCRIPTOR FOR ", s.describedType, depth+1];
};
transfer => {
xferName: ARRAY Symbols.TransferMode OF ROPE = [
"PROC", "PORT", "SIGNAL", "ERROR", "PROCESS", "PROGRAM", NIL, NIL];
IF s.safe # MimData.cedar THEN
errorStream.PutRope[IF s.safe THEN "SAFE " ELSE "UNSAFE "];
errorStream.PutRope[xferName[s.mode]];
IF s.typeIn # Symbols.nullType THEN
PrintTypeExp[" ", s.typeIn, depth];
IF s.typeOut # Symbols.nullType THEN {
PrintTypeExp[" RETURNS ", s.typeOut, depth];
};
};
subrange => {
NumericType: PROC [type: Symbols.Type] RETURNS [BOOL] = INLINE {
nType: CSEIndex = SymbolOps.NormalType[root.stb, type];
RETURN [WITH n: seb[nType] SELECT FROM
signed, unsigned => TRUE,
ENDCASE => FALSE]
};
PrintTypeExp[NIL, s.rangeType, depth+1];
errorStream.PutChar['[];
IF s.filled AND ~s.empty AND NumericType[s.rangeType]
THEN errorStream.PutF["%g..%g", [integer[s.origin]], [integer[s.origin+s.range+1]]]
ELSE errorStream.PutRope["..."];
errorStream.PutChar[')];
};
zone => {
IF ~s.counted THEN errorStream.PutRope["UNCOUNTED "];
errorStream.PutRope["ZONE"];
};
any => errorStream.PutRope["ANY"];
ENDCASE => errorStream.PutRope["..."];
ENDCASE;
};
PrintTypeExp[" (expected ", root.type, 0];
errorStream.PutChar[')];
};
error-handling routines
ErrorLog: PROC [error: BOOL] = {
bodyId: ISEIndex;
index: Loc = MimData.textIndex;
IF error
THEN MimData.nErrors ¬ MimData.nErrors + 1
ELSE MimData.nWarnings ¬ MimData.nWarnings + 1;
errorStream.PutRope[", at "];
IF MimData.bodyIndex # BTNull THEN {
stb: STB ¬ MimData.ownSymbols;
bodyId ¬ stb.bb[MimData.bodyIndex].id;
IF bodyId # ISENull THEN WriteSei[bodyId];
};
IF index # nullLoc THEN errorStream.PutF1["[%d]", [integer[Val[index]]]];
errorStream.PutChar[':];
errorStream.PutChar['\n];
IF index # nullLoc
THEN PrintTextLine[index]
ELSE errorStream.PutRope["(source from inline)\n"];
errorStream.PutChar['\n];
};
}.