LogPack.Mesa
Copyright © 1985 by Xerox Corporation. All rights reserved.
Satterthwaite, June 24, 1986 9:44:18 am PDT
Maxwell, August 11, 1983 8:32 am
Russ Atkinson (RRA) March 6, 1985 10:21:16 pm PST
DIRECTORY
Ascii: TYPE USING [ControlZ],
ComData: TYPE USING [bodyIndex, cedar, nErrors, nWarnings, ownSymbols, switches, textIndex],
CompilerUtil: TYPE USING [AcquireStream, AcquireTable, ReleaseStream, ReleaseTable],
ConvertUnsafe: TYPE USING [SubString],
ErrorTable: TYPE USING [CSRptr],
IO: TYPE USING [card, char, CR, GetChar, EndOf, int, Put, PutChar, PutF, PutRope, rope, SetIndex, SP, STREAM],
LiteralOps: TYPE USING [Value, StringValue, WordIndex],
Log: TYPE USING [ErrorCode, Type],
Rope: TYPE USING [ROPE],
SourceMap: TYPE USING [nullLoc],
Symbols: TYPE USING [Name, ISEIndex, Type, CSEIndex, CTXIndex, TransferMode, nullName, ISENull, nullType, BTNull, codeINT],
SymbolTable: TYPE USING [Base],
Tree: TYPE USING [Base, Index, Link, NodeName, Scan, Null],
TreeOps: TYPE USING [ScanList];
LogPack: PROGRAM
IMPORTS CompilerUtil, IO, LiteralOps, TreeOps, dataPtr: ComData
EXPORTS Log, SourceMap = {
OPEN Symbols;
ErrorCode: TYPE = Log.ErrorCode;
FileByteIndex: TYPE = INT;
source location encoding
Loc: PUBLIC TYPE = CARDINAL;
nullLoc: Loc = SourceMap.nullLoc;
chunkSize: NAT = 256;
maxChunks: NAT = NAT.LAST/chunkSize + 1;
IndexChunk: TYPE = ARRAY [0..chunkSize) OF INT;
ChunkMap: TYPE = ARRAY [0..maxChunks) OF REF IndexChunk;
map: REF ChunkMap ← NIL;
next: CARDINAL ← 0;
Init: PUBLIC PROC = Reset;
Reset: PUBLIC PROC = {
IF map # NIL THEN {
FOR i: NAT IN [0..maxChunks) DO
IF map[i] # NIL THEN FREE[@map[i]]
ENDLOOP;
FREE[@map]};
next ← 0};
Cons: PUBLIC PROC[index: INT] RETURNS[loc: Loc] = {
IF index IN [0..NAT.LAST] THEN loc ← index
ELSE {
chunk: NAT = next/chunkSize;
slot: NAT = next MOD chunkSize;
IF map = NIL THEN map ← NEW[ChunkMap ← ALL[NIL]];
IF map[chunk] = NIL THEN map[chunk] ← NEW[IndexChunk];
map[chunk][slot] ← index;
loc ← next + (NAT.LAST+1); next ← next + 1;
IF next > NAT.LAST THEN ERROR};
RETURN};
Val: PUBLIC PROC[loc: Loc] RETURNS[index: INT] = {
IF loc <= NAT.LAST THEN index ← loc
ELSE {
d: NAT = loc - CARDINAL[NAT.LAST+1];
index ← map[d/chunkSize][d MOD chunkSize]};
RETURN};
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.Put[IO.int[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]]]};
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: Log.Type] = {
Enter[];
PrintOperand[t, 0, 0]; errorStream.PutRope[" "];
WriteErrorString[code]; PrintType[type];
ErrorLog[TRUE];
Exit[]};
Warning: PUBLIC PROC[code: ErrorCode] = {
IF dataPtr.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 dataPtr.switches['w] THEN {
Enter[];
WriteSubString[s]; errorStream.PutChar[' ];
WriteErrorString[code]; ErrorLog[FALSE];
Exit[]}
};
WarningRope: PUBLIC PROC[code: ErrorCode, s: Rope.ROPE] = {
IF dataPtr.switches['w] THEN {
Enter[];
errorStream.Put[IO.rope[s], IO.char[' ]];
WriteErrorString[code]; ErrorLog[FALSE];
Exit[]}
};
WarningTree: PUBLIC PROC[code: ErrorCode, t: Tree.Link] = {
IF dataPtr.switches['w] THEN {
Enter[];
errorStream.PutRope["warning: "];
PrintOperand[t, 0, 0]; errorStream.PutRope[" "];
WriteErrorString[code]; ErrorLog[FALSE];
Exit[]}
};
source printing
PrintTextLine: PROC[i: Loc] = {
start, lineIndex: FileByteIndex;
char: CHAR;
n: [1..100];
sourceStream: IO.STREAM ← CompilerUtil.AcquireStream[$source];
start ← lineIndex ← Val[i];
FOR n IN [1..100] UNTIL lineIndex = 0 DO
lineIndex ← lineIndex - 1;
sourceStream.SetIndex[lineIndex];
IF sourceStream.GetChar[] = IO.CR THEN EXIT;
start ← lineIndex;
ENDLOOP;
sourceStream.SetIndex[start];
FOR n IN [1..100] WHILE ~sourceStream.EndOf[] DO
SELECT (char ← IO.GetChar[sourceStream]) FROM
IO.CR, Ascii.ControlZ => EXIT;
ENDCASE => errorStream.PutChar[char];
ENDLOOP;
errorStream.PutChar['\n];
CompilerUtil.ReleaseStream[$source]};
errorStream, CSRp and desc.base are set by Enter
errorStream: IO.STREAM ← NIL;
CSRp: ErrorTable.CSRptr;
ss: ConvertUnsafe.SubString ← [NIL, 0, 0];
Enter: PROC = {
errorStream ← CompilerUtil.AcquireStream[$log];
CSRp ← CompilerUtil.AcquireTable[error];
ss.base ← @CSRp[CSRp.stringOffset]};
Exit: PROC = {
CompilerUtil.ReleaseTable[error];
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 ← stb.SubStringForName[name];
WriteSubString[s]}
};
WriteErrorString: PROC[n: ErrorCode] = {
ss.offset ← CSRp.ErrorMessages[n].offset;
ss.length ← CSRp.ErrorMessages[n].length;
WriteSubString[ss]};
WriteName: PROC[name: Name] = {
IF name = nullName THEN errorStream.PutRope["(anonymous)"]
ELSE WriteId[dataPtr.ownSymbols, name]};
WriteSei: PROC[sei: ISEIndex] = {
WriteName[IF sei = ISENull
THEN nullName
ELSE dataPtr.ownSymbols.seb[sei].hash]
};
WriteLti: PROC[t: Tree.Link.literal] = {
WITH t.index SELECT FROM
word => errorStream.Put[IO.int[LiteralOps.Value[lti]]];
string => {
s: LONG STRING = LiteralOps.StringValue[sti];
errorStream.PutChar['"];
FOR i: CARDINAL IN [0..s.length) DO
errorStream.PutChar[s[i]] ENDLOOP;
errorStream.PutChar['"]};
ENDCASE
};
tables used for printing trees (pending reordering of node names)
OpName: ARRAY Tree.NodeName[$assignx..$uparrow] OF STRING = [
"←",
" OR ", " AND ", "=", "#", "<", ">=", ">", "<=", " IN ", " ~IN ",
"+", "-", "*", "/", " MOD ",
".", ".", ".",
" NEW ", "~", "-", "@", "^"];
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,
10, 10, 10,
1, 4, 8, 9, 10];
WriteOpName: PROC[n: Tree.NodeName[$assignx..$uparrow]] = {
ss.offset ← CSRp.OpName[n].offset;
ss.length ← CSRp.OpName[n].length;
WriteSubString[ss]};
FnName: ARRAY Tree.NodeName[$min..$new] OF STRING = [
"MIN", "MAX", "LONG", "ABS", "ALL", "SIZE", "FIRST", "LAST", "PRED", "SUCC",
"DESCRIPTOR", "LENGTH", "BASE", "LOOPHOLE", "NIL", "NEW"];
WriteFnName: PROC[n: Tree.NodeName[$min..$new]] = {
ss.offset ← CSRp.FnName[n].offset; ss.length ← CSRp.FnName[n].length;
WriteSubString[ss]};
ApplName: ARRAY Tree.NodeName[$apply..$joinx] OF STRING ← [
"APPLY", "APPLY", "", "SIGNAL", "ERROR", "ERROR", "START", "FORK", "JOIN"];
WriteApplName: PROC[n: Tree.NodeName[$apply..$joinx]] = {
ss.offset ← CSRp.ApplName[n].offset; ss.length ← CSRp.ApplName[n].length;
WriteSubString[ss]};
FApplName: ARRAY Tree.NodeName[$restart..$broadcast] OF STRING ← [
"RESTART", "STOP", "LOCK", "WAIT", "NOTIFY", "BROADCAST"];
WriteFApplName: PROC[n: Tree.NodeName[$restart..$broadcast]] = {
ss.offset ← CSRp.FApplName[n].offset; ss.length ← CSRp.FApplName[n].length;
WriteSubString[ss]};
PrintOperator: PROC[op: Tree.NodeName] = {
IF op IN Tree.NodeName[$apply..$joinx] THEN WriteApplName[op]
ELSE IF op IN Tree.NodeName[$assignx..$uparrow] THEN WriteOpName[op]
ELSE IF op IN Tree.NodeName[$min..$new] THEN WriteFnName[op]
ELSE IF op = $ord THEN errorStream.PutRope["ORD"]
ELSE IF op IN Tree.NodeName[$call..$join] THEN {
applMap: ARRAY Tree.NodeName[$call..$join] OF Tree.NodeName = [
call: $callx, portcall: $portcallx, signal: $signalx, error: $errorx, syserror: $syserrorx,
xerror: $errorx,start: $startx, join: $joinx];
PrintOperator[applMap[op]]}
ELSE IF op IN Tree.NodeName[$restart..$broadcast] THEN WriteFApplName[op]
ELSE errorStream.PutRope["..."]};
Cutoff: CARDINAL = 3;
PrintOperand: PROC[t: Tree.Link, tPrec, depth: CARDINAL] = {
IF t = Tree.Null THEN RETURN;
WITH e: t SELECT FROM
hash => WriteName[e.index];
symbol => WriteSei[e.index];
literal => WriteLti[e];
subtree => {
node: Tree.Index = e.index;
tb: Tree.Base ← dataPtr.ownSymbols.tb;
op: Tree.NodeName = tb[node].name;
IF depth > Cutoff THEN {errorStream.PutRope["..."]; RETURN};
SELECT op FROM
syserror, syserrorx => errorStream.PutRope["ERROR"];
lengthen, --abs,-- IN [first..succ], IN [length..base], nil => {
IF tb[node].son[1] # Tree.Null THEN {
PrintOperand[tb[node].son[1], OpPrec[dot], depth+1];
errorStream.PutChar['.]};
WriteFnName[op]};
ord => {   -- pending reordering of node names
PrintOperand[tb[node].son[1], OpPrec[dot], depth+1];
errorStream.PutRope[".ORD"]};
IN [call .. rowcons], stringinit, IN [min .. loophole], val => {
OPEN tb[node];
args: Tree.Link;
SELECT op FROM
IN [call .. rowcons], stringinit => {
IF son[1] # Tree.Null THEN PrintOperand[son[1], 0, depth];
args ← son[2]};
IN [min .. loophole] => {WriteFnName[op]; args ← son[1]};
val => {errorStream.PutRope["VAL"]; args ← son[1]}; -- until reordered
ENDCASE;
IF args # Tree.Null OR op # nil THEN {
errorStream.PutChar['[];
IF depth = Cutoff AND args.tag = subtree THEN
errorStream.PutRope["..."]
ELSE PrintOperandList[args, depth+1];
IF op IN [call .. joinx] AND nSons > 2 THEN
errorStream.PutRope[" !..."];
errorStream.PutChar[']]}};
IN [assignx .. uparrow] => {
OPEN tb[node];
prec: CARDINAL = OpPrec[op];
IF prec < tPrec THEN errorStream.PutChar['(];
SELECT op FROM
IN [create .. addr] => {WriteOpName[op]; PrintOperand[son[1], prec, depth]};
IN [assignx .. dollar] => {
PrintOperand[son[1], prec, depth+1];
WriteOpName[op];
PrintOperand[son[2], prec+1, depth+1]};
uparrow => {
PrintOperand[son[1], prec, depth];
errorStream.PutChar['^]};
ENDCASE => errorStream.PutChar['?];
IF prec < tPrec THEN errorStream.PutChar[')]};
IN [intOO .. intCC] => {
OPEN tb[node];
errorStream.PutChar[IF op = intOO OR op = intOC THEN '( ELSE '[];
PrintOperand[son[1], 0, depth];
errorStream.PutRope[".."];
PrintOperand[son[2], 0, depth];
errorStream.PutChar[IF op = intOO OR op = intCO THEN ') ELSE ']]};
clit => {
c: CHAR = VAL[LiteralOps.Value[
LiteralOps.WordIndex[NARROW[tb[node].son[1], Tree.Link.literal].index]]];
errorStream.PutChar[''];
IF c >= IO.SP THEN errorStream.PutChar[c]
ELSE {errorStream.PutF["\\%3b", IO.card[c.ORD]]}};
new, cons, listcons => {
IF tb[node].son[1] # Tree.Null THEN {
PrintOperand[tb[node].son[1], OpPrec[dot], depth+1];
errorStream.PutChar['.]};
errorStream.PutRope[
SELECT op FROM new => "NEW", cons => "CONS", ENDCASE => "LIST"];
errorStream.PutChar['[];
IF depth = Cutoff THEN errorStream.PutRope["..."]
ELSE PrintOperandList[tb[node].son[2], depth+1];
errorStream.PutChar[']]};
atom => {
errorStream.PutChar['$];
WITH e1: tb[node].son[1] SELECT FROM hash => WriteName[e1.index]; ENDCASE};
llit, IN [cast .. openx], thread => PrintOperand[tb[node].son[1], tPrec, depth];
item => PrintOperand[tb[node].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: Log.Type] = {
seb: Tree.Base ← root.stb.seb;
ItemPrinter: TYPE = PROC[sei: ISEIndex, depth: NAT];
PrintSei: ItemPrinter = {WriteId[root.stb, seb[sei].hash]};
PrintField: ItemPrinter = {
IF seb[sei].hash # nullName THEN {
WriteId[root.stb, seb[sei].hash]; errorStream.PutRope[": "]};
PrintTypeExp[seb[sei].idType, depth]};
PrintCtxItems: PROC[ctx: CTXIndex, printer: ItemPrinter, depth: NAT] = {
nItems: CARDINAL = root.stb.CtxEntries[ctx];
maxItems: CARDINAL = MIN[nItems, 4/(depth+1)];
n: CARDINAL ← 0;
FOR sei: ISEIndex ← root.stb.FirstCtxSe[ctx], root.stb.NextSe[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[type: Symbols.Type, depth: NAT] = {
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 => {
IF s.var THEN
errorStream.PutRope[IF s.readOnly THEN "READONLY " ELSE "VAR "]
ELSE {
errorStream.PutRope[IF s.counted THEN "REF " ELSE "POINTER TO "];
IF s.readOnly THEN errorStream.PutRope["READONLY "]};
PrintTypeExp[s.refType, depth+1]};
array => {
IF s.packed THEN errorStream.PutRope["PACKED "];
errorStream.PutRope["ARRAY "];
PrintTypeExp[s.indexType, depth+1];
errorStream.PutRope[" OF "];
PrintTypeExp[s.componentType, depth+1]};
arraydesc => {
errorStream.PutRope["DESCRIPTOR FOR "];
PrintTypeExp[s.describedType, depth+1]};
transfer => {
xferName: ARRAY Symbols.TransferMode OF Rope.ROPE = [
"PROC", "PORT", "SIGNAL", "ERROR", "PROCESS", "PROGRAM", NIL];
IF s.safe # dataPtr.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 {
errorStream.PutRope[" RETURNS"]; PrintTypeExp[s.typeOut, depth]};
};
subrange => {
NumericType: PROC[type: Symbols.Type] RETURNS[BOOL] = INLINE {
nType: CSEIndex = root.stb.NormalType[type];
RETURN[WITH n: seb[nType] SELECT FROM
basic => n.code = codeINT,
ENDCASE => FALSE]
};
PrintTypeExp[s.rangeType, depth+1];
errorStream.PutChar['[];
IF s.filled AND ~s.empty AND NumericType[s.rangeType] THEN
errorStream.Put[
IO.int[s.origin], IO.rope[".."], IO.int[s.origin.LONG+s.range+1]]
ELSE errorStream.PutRope["..."];
errorStream.PutChar[')]};
long => {
IF root.stb.RCType[type] = $simple THEN
PrintTypeExp[s.rangeType, depth]
ELSE {errorStream.PutRope["LONG "]; PrintTypeExp[s.rangeType, depth+1]}};
zone => {
IF ~s.counted THEN errorStream.PutRope["UNCOUNTED "];
errorStream.PutRope["ZONE"]};
any => errorStream.PutRope["ANY"];
ENDCASE => errorStream.PutRope["..."];
ENDCASE;
};
errorStream.PutRope[" (expected "]; PrintTypeExp[root.type, 0]; errorStream.PutChar[')]};
error-handling routines
ErrorLog: PROC[error: BOOL] = {
bodyId: ISEIndex;
index: Loc = dataPtr.textIndex;
IF error THEN dataPtr.nErrors ← dataPtr.nErrors + 1
ELSE dataPtr.nWarnings ← dataPtr.nWarnings + 1;
errorStream.PutRope[", at "];
IF dataPtr.bodyIndex # BTNull THEN {
bodyId ← dataPtr.ownSymbols.bb[dataPtr.bodyIndex].id;
IF bodyId # ISENull THEN WriteSei[bodyId]};
IF index # nullLoc THEN errorStream.PutF["[%d]", IO.int[Val[index]]];
errorStream.PutChar[':]; errorStream.PutChar['\n];
IF index # nullLoc THEN PrintTextLine[index]
ELSE errorStream.PutRope["(source from inline)\n"];
errorStream.PutChar['\n]};
}.