[_CDCSL_93-16_]<1>Cedar>release>MimosaOnly>MimStmt.mesa

MimStmt.mesa

Sweet, June 2, 1986 1:06:04 am PDT

Satterthwaite, December 30, 1985 11:51:18 am PST

Russ Atkinson (RRA) March 6, 1991 4:26 pm PST

DIRECTORY

Alloc USING [Base, Notifier],

IntCodeDefs USING [ApplyNode, ArithClass, ArithSelector, BlockNode, CaseList, CaseListRep, Comparator, Handler, HandlerRep, Label, LambdaNode, Node, NodeList, NodeRep, nullFileId, SourceNode, Var, VarList],

MimCode USING [BitAddress, BitCount, caseCV, caseType, catchoutrecord, CodeList, CodeNotImplemented, curctxlvl, fileLoc, inlineFileLoc, LabelInfo, nC1, RegisterNotifier, StoreOptions, z],

MimData USING [checks, idCARDINAL, idINTEGER, idUNWIND, switches, textIndex, worstAlignment],

MimosaLog USING [Error, WarningSei],

MimP5 USING [BindStmtExp, CaseStmtExp, Clarify, Exp, ExpList, GetLabelMark, inInline, LabelCreate, LabelList, MakeExitLabel, Normalize, PushContext, SysError, VarForSei, visibleContext],

MimP5S USING [Assign, Call, CatchMark, ComAssign, Continue, ExtendValue, Exit, Extract, Free, GoTo, Join, LabelStmt, Lock, Loop, Restart, Result, Resume, Retry, Return, RetWithError, SigErr, SplitArith, Start, Stop, Subst, Unlock, WillEvalToConst],

MimP5Stuff USING [GetCard, IsCard],

MimP5U USING [Address, AllocLabel, ApplyOp, ArithClassForTree, ArithClassForType, Assign, BinaryArithOp, BitsForType, BoolTest, BoundsCheck, CJump, Declare, Deref, Extend, ExtractList, FnField, FormalVar, InsertLabel, Jump, MakeArgList, MakeArgList2, MakeBlock, MakeCaseList, MakeConstCard, MakeConstInt, MakeGoTo, MakeNodeList, MakeTemp, MakeVarList, MesaOpNode, MoreCode, NewCodeList, NextVar, NodeIf, OperandType, TakeField, TakeFieldVar, WordsForSei],

SourceMap USING [Loc, nullLoc, Up, Val],

SourceMarks USING [GetProps],

SymbolOps USING [CtxLevel, NextSe, own, SetCtxLevel, TransferTypes],

Symbols USING [Base, bodyType, BTIndex, BTNull, ContextLevel, CSEIndex, CSENull, CTXIndex, CTXNull, ctxType, ISEIndex, ISENull, RecordSEIndex, RecordSENull, SEIndex, seType, Type],

Target: TYPE MachineParms USING [bitsPerProc, bitsPerRef, bitsPerWord],

Tree USING [Base, Index, Link, Node, NodeName, Null, Scan, treeType],

TreeOps USING [GetNode, GetSe, GetTag, NthSon, OpName, ScanList];

MimStmt: PROGRAM

IMPORTS MimCode, MimData, MimosaLog, MimP5, MimP5S, MimP5Stuff, MimP5U, SourceMap, SourceMarks, SymbolOps, TreeOps

EXPORTS MimP5 = {

OPEN IntCodeDefs, MimCode, Target;

bitsPerPtr: NAT = Target.bitsPerRef;

bitsPerSignal: NAT = Target.bitsPerProc;

SourceSeen: SIGNAL [index: SourceMap.Loc] = CODE;

sourceBreak: SourceMap.Loc ¬ SourceMap.nullLoc;

SuspiciousLength: SIGNAL = CODE;

imported definitions

SEIndex: TYPE = Symbols.SEIndex;

ISEIndex: TYPE = Symbols.ISEIndex;

ISENull: ISEIndex = Symbols.ISENull;

CSEIndex: TYPE = Symbols.CSEIndex;

CSENull: CSEIndex = Symbols.CSENull;

RecordSEIndex: TYPE = Symbols.RecordSEIndex;

RecordSENull: RecordSEIndex = Symbols.RecordSENull;

BTIndex: TYPE = Symbols.BTIndex;

BTNull: BTIndex = Symbols.BTNull;

procedures

DeclList: PUBLIC PROC [cl: CodeList, t: Tree.Link] = {

maybe some statements, too

PreId: Tree.Scan = {

sei: ISEIndex = TreeOps.GetSe[t];

IF NOT seb[sei].constant THEN seb[sei].idDecl ¬ 1;

};

PreDecl: Tree.Scan = {

SELECT TreeOps.OpName[t] FROM

decl => TreeOps.ScanList[TreeOps.NthSon[t, 1], PreId];

list => TreeOps.ScanList[t, PreDecl];

ENDCASE;

};

OneDecl: Tree.Scan = {

IF t # Tree.Null THEN

SELECT TreeOps.OpName[t] FROM

decl => DeclItem[cl, TreeOps.GetNode[t]];

typedecl => NULL;

procinit, signalinit => {};

list => TreeOps.ScanList[t, OneDecl];

ENDCASE => MimP5U.MoreCode[cl, StatementTree[t]];

};

TreeOps.ScanList[t, PreDecl];

TreeOps.ScanList[t, OneDecl];

};

StatementList: PUBLIC PROC [cl: CodeList, t: Tree.Link] = {

OneStmt: Tree.Scan = {

new: Node;

WITH e: t SELECT TreeOps.GetTag[t] FROM

subtree => IF tb[e.index].name = decl THEN {DeclItem[cl, e.index]; RETURN};

ENDCASE;

new ¬ StatementTree[t];

IF new # NIL THEN MimP5U.MoreCode[cl, new];

};

TreeOps.ScanList[t, OneStmt];

};

StatementTree: PUBLIC PROC [t: Tree.Link] RETURNS [l: Node ¬ NIL] = {

generates code for Mesa statements

saveIndex: SourceMap.Loc = MimData.textIndex;

recentStmt ¬ t;

IF t # Tree.Null THEN {

ENABLE MimCode.CodeNotImplemented =>

IF ~MimData.switches['d] THEN GO TO unimplemented;

WITH t SELECT TreeOps.GetTag[t] FROM

subtree => {

fIndex: SourceMap.Loc ¬ MimCode.inlineFileLoc;

node: Tree.Index ¬ index;

tp: LONG POINTER TO Tree.Node = @tb[node];

Remember to extract all fields before calling anything that could cause relocation!

IF tp.free THEN ERROR;

IF fIndex = SourceMap.nullLoc THEN

fIndex ¬ LOOPHOLE[tp.info, SourceMap.Loc];

IF fIndex # SourceMap.nullLoc THEN

SELECT tp.name FROM

list, block, null =>

info is not a valid file index

fIndex ¬ SourceMap.nullLoc;

ENDCASE => {

MimCode.fileLoc ¬ MimData.textIndex ¬ fIndex;

};

IF fIndex = sourceBreak AND fIndex # SourceMap.nullLoc THEN

For debugging down to the statement level

SIGNAL SourceSeen[fIndex];

SELECT tp.name FROM

list => {

generates code for multiple statements, no new scope

cl: CodeList ¬ MimP5U.NewCodeList[];

StatementList[cl, t];

l ¬ MimP5U.MakeBlock[cl];

};

block => {

generates code for multiple statements, new scope

cl: CodeList ¬ MimP5U.NewCodeList[];

bti: BTIndex = LOOPHOLE[tb[node].info, BTIndex];

hasDecls: BOOL ¬ FALSE;

DeclList[cl, tb[node].son[1]];

IF cl.head # NIL THEN hasDecls ¬ TRUE;

StatementList[cl, tb[node].son[2]];

IF bti # BTNull

THEN l ¬ WrapSourceBlock[cl, bti, hasDecls]

ELSE l ¬ MimP5U.MakeBlock[cl];

};

start => l ¬ MimP5S.Start[node];

restart => l ¬ MimP5S.Restart[node];

stop => l ¬ MimP5S.Stop[node];

dst, lst, lste, lstf => GO TO unimplemented;

portcall => GO TO unimplemented;

syscall => GO TO unimplemented;

call => l ¬ MimP5S.Call[node];

signal => l ¬ MimP5S.SigErr[node: node, error: FALSE, stmt: TRUE];

error => l ¬ MimP5S.SigErr[node: node, error: TRUE, stmt: TRUE];

syserror => l ¬ MimP5.SysError[];

label => l ¬ MimP5S.LabelStmt[node];

assign => l ¬ MimP5S.Assign[node];

extract => l ¬ MimP5S.Extract[node];

if => {

generates code for an IF statement

son2: Tree.Link = tp.son[2];

son3: Tree.Link = tp.son[3];

test: Node = MimP5.Exp[tp.son[1]];

SELECT MimP5U.BoolTest[test] FROM

true => l ¬ StatementTree[son2];

false => l ¬ StatementTree[son3];

ENDCASE =>

l ¬ MimP5U.NodeIf[test, StatementTree[son2], StatementTree[son3]];

};

case => l¬ MimP5.CaseStmtExp[node, FALSE];

bind => l ¬ MimP5.BindStmtExp[node, FALSE];

do => l ¬ DoStmt[node];

exit => l ¬ MimP5S.Exit[];

loop => l ¬ MimP5S.Loop[];

retry => l ¬ MimP5S.Retry[];

continue => l ¬ MimP5S.Continue[];

goto => l ¬ MimP5S.GoTo[node];

catchmark => l ¬ MimP5S.CatchMark[node];

return => l ¬ MimP5S.Return[node];

resume => l ¬ MimP5S.Resume[node];

reject => l ¬ MimP5U.MakeGoTo[catchEndLabel];

result => l ¬ MimP5S.Result[node];

open => l ¬ StatementTree[tp.son[2]];

enable => {

handler: Handler ¬ SCatchPhrase[tb[node].son[1]];

cl: CodeList ¬ MimP5U.NewCodeList[];

range: NodeList;

StatementList[cl, tb[node].son[2]];

range ¬ MimP5U.ExtractList[cl];

l ¬ z.NEW[NodeRep.enable ¬ [details: enable[handle: handler, scope: range]]];

};

checked => l ¬ StatementTree[tp.son[1]];

wait => {

monitor: Node ¬ MimP5U.Address[MimP5.Exp[tb[node].son[1]]];

condition: Node ¬ MimP5U.Address[MimP5.Exp[tb[node].son[2]]];

apply: ApplyNode ¬ NARROW[MimP5U.ApplyOp[
oper: MimP5U.MesaOpNode[wait],
args: MimP5U.MakeArgList2[monitor, condition]]];

IF tb[node].nSons > 2 THEN

apply.handler ¬ SCatchPhrase[tb[node].son[3]];

l ¬ apply;

};

notify => {

condition: Node ¬ MimP5U.Address[MimP5.Exp[tb[node].son[1]]];

args: NodeList ¬ MimP5U.MakeArgList[condition];

l ¬ MimP5U.ApplyOp[oper: MimP5U.MesaOpNode[notify], args: args, bits: 0];

};

broadcast => {

condition: Node ¬ MimP5U.Address[MimP5.Exp[tb[node].son[1]]];

args: NodeList ¬ MimP5U.MakeArgList[condition];

l ¬ MimP5U.ApplyOp[oper: MimP5U.MesaOpNode[broadcast], args: args, bits: 0];

};

join => l ¬ MimP5S.Join[node];

unlock => l ¬ MimP5S.Unlock[node];

lock => l ¬ MimP5S.Lock[node];

subst => l ¬ MimP5S.Subst[node];

free => l ¬ MimP5S.Free[node];

xerror => l ¬ MimP5S.RetWithError[node];

null => {};

ENDCASE => GO TO unimplemented;

IF fIndex # SourceMap.nullLoc THEN l ¬ WrapSource[l, fIndex];

Nest this statement in a source node

};

ENDCASE;

EXITS

unimplemented => MimosaLog.Error[unimplemented];

};

MimData.textIndex ¬ saveIndex;

};

DeclItem: PROC [cl: CodeList, node: Tree.Index] = {

initVal: Node ¬ NIL;

initTree: Tree.Link ¬ tb[node].son[3];

first: BOOL ¬ TRUE;

OneId: Tree.Scan = {

sei: ISEIndex ¬ TreeOps.GetSe[t];

IF NOT seb[sei].constant THEN {

type: Symbols.Type = seb[sei].idType;

var: Var = MimP5.VarForSei[sei];

varBits: INT = var.bits;

IF initTree = Tree.Null THEN {

nt: CSEIndex = MimP5.Normalize[type];

typeBits: INT = MimP5U.BitsForType[nt];

offset: INT = typeBits MOD bitsPerWord;

IF typeBits < varBits AND offset # 0 THEN {

This variable could use some zeros to make values kosher just in case some yurk assigns to things element by element.

WITH se: seb[nt] SELECT FROM

record, array => {

options: MimCode.StoreOptions = [init: TRUE];

lastWord: Var = MimP5U.TakeFieldVar[var, typeBits-offset, bitsPerWord];

zero: Node = MimP5U.MakeConstCard[0];

MimP5U.Declare[cl, var];

seb[sei].idDecl ¬ 0;

MimP5U.MoreCode[cl, MimP5U.Assign[lhs: lastWord, rhs: zero]];

IF MimData.checks['p] THEN

The use wants to know about this!

MimosaLog.WarningSei[paddedField, sei];

first ¬ FALSE;

RETURN;

};

ENDCASE;

};

IF first THEN {

first ¬ FALSE;

IF initTree # Tree.Null THEN {

There is an initialization value

initType: Symbols.Type = MimP5U.OperandType[initTree];

padded: BOOL ¬ FALSE;

t: Tree.Link ¬ initTree;

SELECT TreeOps.OpName[t] FROM

pad => {t ¬ TreeOps.NthSon[t, 1]; padded ¬ TRUE};

cast => t ¬ TreeOps.NthSon[t, 1];

ENDCASE => EXIT;

ENDLOOP;

IF padded AND varBits > bitsPerWord THEN {

options: MimCode.StoreOptions = [init: TRUE];

MimP5U.Declare[cl, var];

seb[sei].idDecl ¬ 0;

MimP5U.MoreCode[cl,
MimP5S.ComAssign[t1: [symbol[sei]], t2: initTree, options: options]];

initVal ¬ var;

RETURN;

};

initVal ¬ MimP5.Exp[t];

IF initVal # NIL AND initVal.bits < varBits THEN

initVal ¬ MimP5S.ExtendValue[
node: initVal, dstType: type, srcType: initType, bits: var.bits];

};

seb[sei].idDecl ¬ 0;

MimP5U.Declare[cl: cl, var: var, init: initVal];

IF initVal # NIL AND initVal.kind # const THEN initVal ¬ var;

};

fIndex: SourceMap.Loc ¬ MimCode.inlineFileLoc;

oldCL: CodeList ¬ cl;

IF fIndex = SourceMap.nullLoc THEN

fIndex ¬ LOOPHOLE[tb[node].info, SourceMap.Loc];

IF fIndex # SourceMap.nullLoc AND NOT MimP5.inInline THEN {

For error & warning tracking

pos: INT = SourceMap.Val[fIndex];

IF pos >= 0 THEN {

IF fIndex = sourceBreak THEN SIGNAL SourceSeen[fIndex];

For debugging down to the statement level

MimCode.fileLoc ¬ MimData.textIndex ¬ fIndex;

cl ¬ MimP5U.NewCodeList[];

TreeOps.ScanList[tb[node].son[1], OneId];

MimP5U.MoreCode[oldCL, WrapList[MimP5U.ExtractList[cl], fIndex]];

RETURN;

};

TreeOps.ScanList[tb[node].son[1], OneId];

};

DoStmt: PROC [rootNode: Tree.Index] RETURNS [l: Node] = {

generates code for all the loop statments

preBodyTest: Tree.Link = tb[rootNode].son[2];

exitsCode: Tree.Link = tb[rootNode].son[5];

finishingCode: Tree.Link = tb[rootNode].son[6];

finLabel: Label = MimP5U.AllocLabel[];

endLabel: Label ¬ NIL;

loopLabel: Label ¬ NIL;

labelMark: LabelInfo = MimP5.GetLabelMark[];

cl: CodeList = MimP5U.NewCodeList[];

body: Node ¬ NIL;

TestAndBody: PROC = {

now the pre-body test (if any)

IF preBodyTest # Tree.Null THEN {

case: CaseList ¬ MimP5U.MakeCaseList[
MimP5U.MakeNodeList[MimP5.Exp[preBodyTest]], NIL, MimP5U.MakeCaseList[NIL, MimP5U.MakeGoTo[finLabel]]];

cond: Node ¬ z.NEW[NodeRep.cond ¬ [details: cond[case]]];

MimP5U.MoreCode[cl, cond];

};

body ¬ StatementTree[tb[rootNode].son[4]];

MimP5U.MoreCode[cl, body];

};

set up for EXIT clause

[exit: endLabel, loop: loopLabel] ¬ MimP5.MakeExitLabel[];

TreeOps.ScanList[exitsCode, MimP5.LabelCreate];

IF tb[rootNode].son[1] = Tree.Null

THEN {

MimP5U.InsertLabel[cl, loopLabel];

TestAndBody[];

MimP5U.Jump[cl, loopLabel];

}

ELSE {

ignore the opens (tb[rootNode].son3)

topLabel: Label = MimP5U.AllocLabel[];

node: Tree.Index = TreeOps.GetNode[tb[rootNode].son[1]];

son1: Tree.Link = tb[node].son[1];

son2: Tree.Link = tb[node].son[2];

bti: BTIndex = LOOPHOLE[tb[node].info, BTIndex];

options: MimCode.StoreOptions = [];

name: Tree.NodeName = tb[node].name;

IF bti # BTNull THEN EnterBlock[cl, bti];

SELECT name FROM

forseq => {

forSeqUpdateCode: Tree.Link = tb[node].son[3];

indexType: Symbols.Type = MimP5U.OperandType[son1];

ac: ArithClass = MimP5U.ArithClassForType[indexType];

indexVar: Var = MimP5.VarForSei[TreeOps.GetSe[son1]];

indexVar.flags[frequent] ¬ ac.kind < real;

IF bti # BTNull THEN MimP5U.Declare[cl, indexVar, NIL];

or some better test of locally declared indexVar?

IF son2 # Tree.Null THEN

There is an initial value for the control variable

MimP5U.MoreCode[cl, MimP5S.ComAssign[son1, son2, options]];

MimP5U.InsertLabel[cl, topLabel];

TestAndBody[];

now (update and) test the control variable

IF loopLabel.used THEN MimP5U.InsertLabel[cl, loopLabel];

IF forSeqUpdateCode # Tree.Null THEN

We need to update the variable

MimP5U.MoreCode[cl, MimP5S.ComAssign[son1, forSeqUpdateCode, options]];

MimP5U.Jump[cl, topLabel, TRUE];

};

upthru, downthru => {

New style, here to handle the various kinds of intervals, as well as trying to handle increments & decrements

upLoop: BOOL ¬ tb[node].name = upthru;

cvBound: Node ¬ NIL;

knownNonEmpty: BOOL = tb[node].attr1;

subNode: Tree.Index = TreeOps.GetNode[son2];

indexTree: Tree.Link ¬ son1;

indexVar: Var ¬ NIL;

intervalKind: Tree.NodeName ¬ tb[subNode].name;

loSon: Tree.Link ¬ tb[subNode].son[1];

loVal: Node ¬ MimP5.Exp[loSon];

hiSon: Tree.Link ¬ tb[subNode].son[2];

hiVal: Node ¬ MimP5.Exp[hiSon];

ac: ArithClass ¬ MimP5U.ArithClassForTree[subNode];

gac: ArithClass ¬ ac;

bias: Node ¬ NIL;

indexType: Symbols.Type ¬ IF ac.kind = signed
THEN MimData.idINTEGER
ELSE MimData.idCARDINAL;

groundType: Symbols.Type ¬ indexType;

IncrOp: PROC [val: Node, incr: Node, op: ArithSelector] RETURNS [Node] = {

thisClass: ArithClass ¬ ac;

bits: INT = MAX[thisClass.precision, val.bits, incr.bits];

thisClass.precision ¬ bits;

IF val.bits < bits THEN val ¬ MimP5U.Extend[val, bits, groundType];

IF incr.bits < bits THEN incr ¬ MimP5U.Extend[incr, bits, groundType];

IF bits = bitsPerWord THEN {

Try to combine constants

valCard: CARD;

incrCard: CARD;

const: Node ¬ NIL;

[val, valCard] ¬ MimP5S.SplitArith[val];

[incr, incrCard] ¬ MimP5S.SplitArith[incr];

IF incrCard # 0 THEN

SELECT op FROM

add => valCard ¬ valCard + incrCard;

sub => valCard ¬ valCard - incrCard;

ENDCASE => ERROR;

const ¬ MimP5U.MakeConstCard[valCard];

SELECT TRUE FROM

val = NIL => {

IF incr = NIL THEN RETURN [const];

IF valCard = 0 THEN RETURN [incr];

val ¬ const;

};

incr = NIL => {

IF valCard = 0 THEN RETURN [val];

op ¬ add;

incr ¬ const;

IF valCard > CARD[LAST[INT]] THEN {

incr ¬ MimP5U.MakeConstInt[-LOOPHOLE[valCard, INT]];

op ¬ sub;

};

valCard = 0 => {};

ENDCASE => val ¬ MimP5U.BinaryArithOp[add, thisClass, val, const]

};

RETURN [MimP5U.BinaryArithOp[op, thisClass, val, incr]];

};

AssignIncr: PROC [val: Node, incr: Node, op: ArithSelector] = {

var: Var = NARROW[val];

MimP5U.MoreCode[cl, MimP5U.Assign[var, IncrOp[val, MimCode.nC1, op]]];

};

Bump: PROC [val: Node, incr: Node, op: ArithSelector] RETURNS [Node] = {

new: Node = IncrOp[val, MimCode.nC1, op];

WITH val SELECT FROM

var: Var => MimP5U.MoreCode[cl, MimP5U.Assign[var, new]];

ENDCASE => val ¬ new;

RETURN [val];

};

FrequentTemp: PROC
[val: Node, son: Tree.Link, forceTemp: BOOL] RETURNS [Node] = {

IF indexVar # NIL AND indexVar.bits > val.bits THEN {

Not wide enough, so convert it

ac.precision ¬ indexVar.bits;

val ¬ MimP5S.ExtendValue[

node: val,

dstType: indexType,

srcType: MimP5U.OperandType[son],

bits: indexVar.bits];

};

IF forceTemp AND bias = NIL AND indexVar # NIL AND bti # BTNull THEN {

This control variable is used for the low (or high) bound

MimP5U.Declare[cl, indexVar, val];

val ¬ indexVar;

indexVar ¬ NIL;

RETURN [val];

};

IF forceTemp OR NOT MimP5S.WillEvalToConst[son] THEN {

The low value needs a temporary

sei: ISEIndex;

tv: Var;

[tv, sei] ¬ MimP5U.MakeTemp[cl, val.bits, val, indexType];

tv.flags[frequent] ¬ TRUE;

val ¬ tv;

};

RETURN [val];

};

IF tb[node].nSons > 2 THEN {

RRA: See Pass4S.ForClause for details.

son3: Tree.Link = tb[node].son[3];

IF son3 # Tree.Null THEN cvBound ¬ MimP5.Exp[son3];

};

WITH s1: indexTree SELECT TreeOps.GetTag[indexTree] FROM

symbol => {

The loop variable is already a variable

indexType ¬ MimP5U.OperandType[indexTree];

groundType ¬ MimP5.Normalize[indexType];

indexVar ¬ MimP5.VarForSei[s1.index];

indexVar.flags[frequent] ¬ TRUE;

{

ut: CSEIndex = MimP5.Clarify[indexType];

WITH se: seb[ut] SELECT FROM

subrange => IF se.biased THEN

IF se.origin # 0 THEN bias ¬ MimP5U.MakeConstInt[-se.origin];

ENDCASE;

};

ENDCASE;

gac ¬ MimP5U.ArithClassForType[groundType];

IF gac.precision < bitsPerWord THEN gac.precision ¬ bitsPerWord;

IF MimP5Stuff.IsCard[loVal] THEN SELECT intervalKind FROM

intOC, intOO => {

lb: CARD = MimP5Stuff.GetCard[loVal];

IF lb # CARD[INT.LAST] AND lb # CARD.LAST THEN {

Make intervalKind more closed (it's OK to do so)

loVal ¬ IncrOp[loVal, MimCode.nC1, add];

intervalKind ¬ IF intervalKind = intOC THEN intCC ELSE intCO;

};

ENDCASE;

IF MimP5Stuff.IsCard[hiVal] THEN SELECT intervalKind FROM

intCO, intOO => {

lb: CARD = MimP5Stuff.GetCard[hiVal];

IF lb # 0 AND lb # CARD[INT.LAST]+1 THEN {

Make intervalKind more closed (it's OK to do so)

hiVal ¬ IncrOp[hiVal, MimCode.nC1, sub];

intervalKind ¬ IF intervalKind = intCO THEN intCC ELSE intOC;

};

ENDCASE;

Force loVal & hiVal into variables if necessary

loVal ¬ FrequentTemp[loVal, loSon, name = upthru];

hiVal ¬ FrequentTemp[hiVal, hiSon, name = downthru];

IF NOT knownNonEmpty THEN {

Initial test for the empty interval (use ground type for comparison!)

Take care! This test normally should be performed BEFORE adjusting for the intervalKind, since doing it after can give erroneous results around 0 for unsigned numbers.

tst: Comparator ¬ IF intervalKind = intCC THEN gt ELSE ge;

MimP5U.CJump[cl: cl, test: tst, ac: gac, op1: loVal, op2: hiVal, target: finLabel];

};

Make sure that the starting value is correct.

SELECT intervalKind FROM

intOC => IF name = upthru THEN {

loVal ¬ Bump[loVal, MimCode.nC1, add];

intervalKind ¬ intCC;

};

intCO => IF name # upthru THEN {

hiVal ¬ Bump[hiVal, MimCode.nC1, sub];

intervalKind ¬ intCC;

};

intOO => {

If both ends are open the first test was not sufficient, so there is an additional test. It is unlikely that either end was constant.

IF name = upthru

THEN {loVal ¬ Bump[loVal, MimCode.nC1, add]; intervalKind ¬ intCO}

ELSE {hiVal ¬ Bump[hiVal, MimCode.nC1, sub]; intervalKind ¬ intOC};

IF NOT knownNonEmpty THEN

MimP5U.CJump[cl: cl,
test: eq,
op1: loVal, op2: hiVal, ac: gac, target: finLabel, backwards: FALSE];

};

ENDCASE;

MimP5U.InsertLabel[cl, topLabel];

{

localControl: Var = NARROW[IF name = upthru THEN loVal ELSE hiVal];

limit: Node = IF name = upthru THEN hiVal ELSE loVal;

op: ArithSelector = IF name = upthru THEN add ELSE sub;

closedLimit: BOOL ¬ FALSE;

SELECT intervalKind FROM

intCC => closedLimit ¬ TRUE;

intCO => IF name # upthru THEN closedLimit ¬ TRUE;

intOC => IF name = upthru THEN closedLimit ¬ TRUE;

ENDCASE => ERROR;

IF indexVar # NIL THEN {

Update to the index variable

newVal: Node ¬ localControl;

newType: Symbols.Type ¬
MimP5U.OperandType[IF name = upthru THEN loSon ELSE hiSon];

IF newVal.bits < indexVar.bits THEN

We got the bound from some funny place that needs to be large enough

newVal ¬ MimP5U.Extend[newVal, indexVar.bits, newType];

IF cvBound # NIL THEN

Must bounds check the assignment to the control variable

newVal ¬ MimP5U.BoundsCheck[newVal, cvBound];

IF bias # NIL THEN

The control variable is kept biased

newVal ¬ IncrOp[newVal, bias, add];

IF bti # BTNull

THEN MimP5U.Declare[cl, indexVar, newVal]

ELSE MimP5U.MoreCode[cl, MimP5U.Assign[indexVar, newVal]];

};

TestAndBody[];

now (update and) test the lo & hi variables

IF loopLabel.used THEN MimP5U.InsertLabel[cl, loopLabel];

Increment the controlling variables and test. If we have a closed limit, then we test for completion before the variables are incremented. If we have an open limit, we increment the variables before the test.

IF bti = BTNull AND indexVar # NIL THEN {

Fix for AR 1502. Sigh, we have to assign the indexVar back to either the loVal or the hiVal to ensure that any possible alteration to the indexVar in the body gets reflected back into the test. This should be done better!

temp: Node ¬ IF bias = NIL THEN indexVar ELSE IncrOp[indexVar, bias, sub];

IF temp.bits < localControl.bits THEN

Must extend to fit the temporary

temp ¬ MimP5U.Extend[temp, indexVar.bits, groundType];

MimP5U.MoreCode[cl, MimP5U.Assign[localControl, temp]];

};

IF closedLimit THEN

Test before increment

MimP5U.CJump[cl: cl,
test: ge,
op1: loVal, op2: hiVal, ac: ac, target: finLabel, backwards: FALSE];

AssignIncr[localControl, MimCode.nC1, op];

IF closedLimit

THEN MimP5U.Jump[cl, topLabel, TRUE]

Loop to top after increment

ELSE MimP5U.CJump[cl: cl,
test: lt,
op1: loVal, op2: hiVal, ac: ac, target: topLabel, backwards: TRUE];

Test after increment

IF exitsCode # Tree.Null OR finishingCode # Tree.Null THEN

MimP5U.Jump[cl, finLabel, FALSE];

};

ENDCASE;

};

now the labelled EXITs (if any)

MimP5.LabelList[cl, exitsCode, endLabel, labelMark];

finally the FINISHED clause (if any)

IF finLabel.used THEN {

MimP5U.InsertLabel[cl, finLabel];

IF finishingCode # Tree.Null THEN MimP5U.MoreCode[cl, StatementTree[finishingCode]];

};

IF endLabel.used THEN MimP5U.InsertLabel[cl, endLabel];

RETURN [MimP5U.MakeBlock[cl]];

};

SCatchPhrase: PUBLIC PROC [t: Tree.Link] RETURNS [Handler] = {

main subr for catchphrases and ENABLEs

handler: Handler ¬ NIL;

IF t # Tree.Null THEN {

insider: PROC = {

CatchArm: PROC [t: Tree.Link] = {

node: Tree.Index ¬ TreeOps.GetNode[t]; -- t is an item

tests: NodeList ¬ MimP5.ExpList[tb[node].son[1], FALSE].head;

body: Node ¬ CatchItem[node: node, argPtr: argPtr];

arm: CaseList ¬ z.NEW[CaseListRep ¬ [tests: tests, body: body, rest: NIL]];

IF armTail = NIL THEN armHead ¬ arm ELSE armTail.rest ¬ arm;

armTail ¬ arm;

};

node: Tree.Index = TreeOps.GetNode[t];

armHead, armTail: CaseList ¬ NIL;

Formal parameters

regsPtr: Var ¬ MimP5U.FormalVar[bitsPerPtr];

except: Var ¬ MimP5U.FormalVar[bitsPerSignal];

rtnPtr: Var ¬ MimP5U.FormalVar[bitsPerPtr];

argPtr: Var ¬ MimP5U.FormalVar[bitsPerPtr];

formals: VarList ¬ MimP5U.MakeVarList[regsPtr,
MimP5U.MakeVarList[except,
MimP5U.MakeVarList[rtnPtr,
MimP5U.MakeVarList[argPtr]]]];

lambda: LambdaNode ¬ z.NEW[NodeRep.lambda ¬ [details: lambda[
parent: enclosingContext,
kind: catch,
bitsOut: 0,
formalArgs: formals,
body: NIL]]]; -- will fill in body field soon

catchEndLabel ¬ MimP5U.AllocLabel[];

MimCode.caseCV ¬ except;

MimCode.caseType ¬ seb[MimData.idUNWIND].idType;

TreeOps.ScanList[tb[node].son[1], CatchArm];

IF tb[node].son[2] # Tree.Null THEN {

The ANY catch phrase has no test

ec: Node ¬ StatementTree[tb[node].son[2]];

other: CaseList ¬ z.NEW[CaseListRep ¬ [tests: NIL, body: ec, rest: NIL]];

IF armHead = NIL THEN armHead ¬ other ELSE armTail.rest ¬ other;

};

MimP5U.MoreCode[cl, z.NEW[NodeRep.cond ¬ [details: cond[armHead]]]];

MimP5U.InsertLabel[cl, catchEndLabel];

MimP5U.MoreCode[cl, MimP5U.ApplyOp[MimP5U.MesaOpNode[reject], NIL]];

lambda.body ¬ MimP5U.ExtractList[cl];

catchLabel.node ¬ lambda;

handler ¬ z.NEW[HandlerRep ¬ [
context: NIL,
proc: z.NEW[NodeRep.label ¬ [details: label[catchLabel]]]]];

};

cl: CodeList ¬ MimP5U.NewCodeList[];

enclosingContext: Label ¬ MimP5.visibleContext[MimCode.curctxlvl];

catchLabel: Label ¬ MimP5U.AllocLabel[];

oldCatchEnd: Label ¬ catchEndLabel;

MimP5.PushContext[catchLabel, cl, insider];

catchEndLabel ¬ oldCatchEnd;

};

RETURN [handler];

};

CatchItem: PROC [node: Tree.Index, argPtr: Node] RETURNS [Node] = {

generate code for a CATCH item

inCtx, outCtx: Symbols.CTXIndex ¬ Symbols.CTXNull;

saveCatchOutRecord: RecordSEIndex = MimCode.catchoutrecord;

saveInCtxLevel, saveOutCtxLevel: Symbols.ContextLevel;

body: Node ¬ NIL;

bodyStmts: NodeList ¬ NIL;

cl: CodeList ¬ MimP5U.NewCodeList[];

tSei: CSEIndex = MimP5.Clarify[LOOPHOLE[tb[node].info, SEIndex]];

IF tSei = Symbols.CSENull

THEN MimCode.catchoutrecord ¬ RecordSENull

ELSE {

inRecord, outRecord: RecordSEIndex;

[inRecord, outRecord] ¬ SymbolOps.TransferTypes[SymbolOps.own, tSei];

MimCode.catchoutrecord ¬ outRecord;

IF inRecord # RecordSENull THEN {

inCtx ¬ seb[inRecord].fieldCtx;

saveInCtxLevel ¬ SymbolOps.CtxLevel[SymbolOps.own, inCtx];

SymbolOps.SetCtxLevel[inCtx, MimCode.curctxlvl];

GetSignalParams[cl, argPtr, inRecord];

};

IF outRecord # RecordSENull THEN {

The output record

ctx: Symbols.CTXIndex ¬ outCtx ¬ seb[outRecord].fieldCtx;

sei: ISEIndex ¬ MimP5U.NextVar[ctxb[ctx].seList];

saveOutCtxLevel ¬ SymbolOps.CtxLevel[SymbolOps.own, ctx];

SymbolOps.SetCtxLevel[outCtx, MimCode.curctxlvl];

UNTIL sei = ISENull DO

MimP5U.Declare[cl, MimP5.VarForSei[sei]];

sei ¬ MimP5U.NextVar[SymbolOps.NextSe[SymbolOps.own, sei]];

ENDLOOP;

};

body ¬ StatementTree[tb[node].son[2]];

WITH body SELECT FROM

block: BlockNode => bodyStmts ¬ block.nodes;

ENDCASE => bodyStmts ¬ MimP5U.MakeNodeList[body];

IF cl.tail = NIL THEN cl.head ¬ bodyStmts ELSE cl.tail.rest ¬ bodyStmts;

MimCode.catchoutrecord ¬ saveCatchOutRecord;

IF inCtx # Symbols.CTXNull THEN SymbolOps.SetCtxLevel[inCtx, saveInCtxLevel];

IF outCtx # Symbols.CTXNull THEN SymbolOps.SetCtxLevel[outCtx, saveOutCtxLevel];

RETURN [MimP5U.MakeBlock[cl]];

};

GetSignalParams: PROC [cl: CodeList, argPtr: Node, irecord: RecordSEIndex] = {

IF irecord # CSENull THEN {

nParms: INT ¬ MimP5U.WordsForSei[irecord];

IF nParms # 0 THEN {

totalBits: BitCount ¬ MimP5U.BitsForType[irecord];

args: Node ¬ MimP5U.Deref[n: argPtr, bits: totalBits, align: MimData.worstAlignment];

sei: ISEIndex ¬ MimP5U.NextVar[ctxb[seb[irecord].fieldCtx].seList];

UNTIL sei = ISENull DO

offset: BitAddress;

size: BitCount;

var: Var = MimP5.VarForSei[sei];

init: Node ¬ NIL;

[offset, size] ¬ MimP5U.FnField[sei];

init ¬ MimP5U.TakeField[args, offset, size];

MimP5U.Declare[cl: cl, var: var, init: init];

sei ¬ MimP5U.NextVar[SymbolOps.NextSe[SymbolOps.own, sei]];

ENDLOOP;

};

EnterBlock: PROC [cl: CodeList, bti: BTIndex] = {

fIndex: SourceMap.Loc ¬ MimCode.inlineFileLoc;

IF fIndex = SourceMap.nullLoc THEN

fIndex ¬ SourceMap.Up[bb[bti].sourceIndex];

IF fIndex # SourceMap.nullLoc THEN

MimP5U.MoreCode[cl, WrapSource[NIL, fIndex]];

};

ReplaceNode: PROC [sn: SourceNode] = {

start: INT ¬ sn.source.start;

IF sn.nodes # NIL THEN {

end: INT ¬ SourceMarks.GetProps[start].endPos;

IF end > start THEN sn.source.chars ¬ end-start;

};

WrapSource: PUBLIC PROC [node: Node, loc: SourceMap.Loc] RETURNS [Node] = {

IF MimP5.inInline AND NOT MimData.switches['h] THEN RETURN [node];

IF loc # SourceMap.nullLoc THEN {

pos: INT = SourceMap.Val[loc];

IF pos >= 0 THEN {

bits: INT ¬ IF node = NIL THEN 0 ELSE node.bits;

node ¬ WrapList[IF node = NIL THEN NIL ELSE MimP5U.MakeNodeList[node], loc];

node.bits ¬ bits;

};

RETURN [node];

};

WrapList: PROC [list: NodeList, loc: SourceMap.Loc] RETURNS [SourceNode] = {

pos: INT ¬ SourceMap.Val[loc];

sn: SourceNode ¬ z.NEW[NodeRep.source ¬ [

bits: 0,

details: source[

source: [start: pos, chars: 0, file: nullFileId],

nodes: list]]];

ReplaceNode[sn];

RETURN [sn];

};

WrapSourceBlock: PUBLIC PROC
[cl: CodeList, bti: BTIndex, hasDecls: BOOL] RETURNS [Node] = {

startPos: INT ¬ -1;

fIndex: SourceMap.Loc ¬ MimCode.inlineFileLoc;

sn: SourceNode ¬ NIL;

IF MimP5.inInline AND NOT MimData.switches['h] THEN

RETURN [MimP5U.MakeBlock[cl]];

IF fIndex = SourceMap.nullLoc THEN

fIndex ¬ SourceMap.Up[bb[bti].sourceIndex];

IF fIndex # SourceMap.nullLoc THEN

startPos ¬ SourceMap.Val[fIndex];

IF startPos < 0 THEN RETURN [MimP5U.MakeBlock[cl]];

sn ¬ WrapList[IF hasDecls
THEN MimP5U.MakeNodeList[MimP5U.MakeBlock[cl]]
ELSE MimP5U.ExtractList[cl],
fIndex];

ReplaceNode[sn];

RETURN [sn];

};

bases & notifier

tb: Tree.Base ¬ NIL; -- tree base (local copy)

seb: Symbols.Base ¬ NIL; -- semantic entry base (local copy)

ctxb: Symbols.Base ¬ NIL; -- context entry base (local copy)

bb: Symbols.Base ¬ NIL; -- body base (local copy)

StatementNotify: Alloc.Notifier = {

called by allocator whenever table area is repacked

seb ¬ base[Symbols.seType];

ctxb ¬ base[Symbols.ctxType];

bb ¬ base[Symbols.bodyType];

tb ¬ base[Tree.treeType];

};

catchEndLabel: Label ¬ NIL;

recentStmt: PUBLIC Tree.Link; -- for debugging

MimCode.RegisterNotifier[StatementNotify];