Pass3M.mesa
Copyright © 1985 by Xerox Corporation. All rights reserved.
Satterthwaite, June 6, 1986 3:30:47 pm PDT
Donahue, 9-Dec-81 14:45:35
Maxwell, July 28, 1983 11:46 am
Russ Atkinson (RRA) March 6, 1985 10:43:05 pm PST
DIRECTORY
A3: TYPE USING [Bundling, CanonicalType, DefaultInit, LongPath, NewableType, OperandInternal, OperandLhs, OperandType, TargetType, TypeForTree, Unbundle, Voidable],
Alloc: TYPE USING [Notifier, Top],
ComData: TYPE USING [bodyIndex, idLOCK, idUNWIND, ownSymbols, seAnon, stopping, table, textIndex, typeCONDITION, typeListANY, typeLOCK],
ConvertUnsafe: TYPE USING [SubString],
Log: TYPE USING [Error, ErrorNode, ErrorSei, ErrorTree, ErrorTreeOp],
Pass3: TYPE USING [lockNode],
P3: TYPE USING [Attr, fullAttr, NPUse, Safety, TextForm, pathNP, phraseNP, BoundNP, MergeNP, SequenceNP, SetNP, And, Apply, BindTree, BumpArgRefs, CheckLength, CheckLocals, CheckScope, ClearRefStack, EnterType, EnterComposite, Exp, FieldVoid, FirstId, InitialExp, KeyedList, MakeLongType, MakeRefType, MatchFields, PopCtx, PushCtx, RAttr, Rhs, RPop, RPush, RType, SafetyAttr, SetSafety, SealRefStack, SearchCtxList, Stmt, TypeAppl, UnsealRefStack, UpdateTreeAttr, UType, VoidComponent, VoidExp],
P3S: TYPE USING [BodyData, continued, currentBody, markCatch, safety],
SourceMap: TYPE USING [Loc],
Symbols: TYPE USING [Base, HTIndex, SERecord, Type, ISEIndex, CSEIndex, RecordSEIndex, RefSEIndex, CTXIndex, BodyRecord, BTIndex, CBTIndex, HTNull, nullType, ISENull, CSENull, RecordSENull, CTXNull, CBTNull, lG, lZ, RootBti, typeANY, seType, ctxType, mdType, bodyType],
SymbolOps: TYPE USING [ArgCtx, ArgRecord, CtxLevel, EnterString, EqTypes, FindString, FirstCtxSe, MakeNonCtxSe, NextSe, NormalType, ReferentType, SetCtxLevel, TransferTypes, TypeForm, TypeRoot, UnderType, XferMode],
Tree: TYPE USING [Base, Index, Link, Map, NodeName, Null, NullIndex, Scan, treeType],
TreeOps: TYPE USING [FreeNode, FreeTree, GetNode, MakeList, MakeNode, NthSon, PopTree, PushTree, PushSe, PushNode, PutAttr, OpName, ReverseUpdateList, ScanList, SetAttr, SetInfo, UpdateList],
Types: TYPE USING [Assignable, Equivalent];
Pass3M: PROGRAM
IMPORTS A3, Alloc, Log, P3, P3S, SymbolOps, TreeOps, Types, dataPtr: ComData, passPtr: Pass3
EXPORTS P3 = {
OPEN SymbolOps, Symbols, A3, P3, TreeOps;
InsertCatchLabel: PUBLIC SIGNAL[catchSeen, exit: BOOL] = CODE;
tb: Tree.Base; -- tree base address (local copy)
seb: Symbols.Base; -- se table base address (local copy)
ctxb: Symbols.Base; -- context table base (local copy)
mdb: Symbols.Base; -- module table base (local copy)
bb: Symbols.Base; -- body table base (local copy)
MiscNotify: PUBLIC Alloc.Notifier = {
called by allocator whenever table area is repacked
tb ← base[Tree.treeType];
seb ← base[seType]; ctxb ← base[ctxType]; mdb ← base[mdType];
bb ← base[bodyType]};
current: POINTER TO P3S.BodyData = @P3S.currentBody;
statements
MiscStmt: PUBLIC PROC[node: Tree.Index] RETURNS[val: Tree.Link] = {
val ← [subtree[index: node]]; -- the default
SELECT tb[node].name FROM
signal, error, start, join, wait => {
PushTree[SELECT tb[node].name FROM
start => Start[node],
join => Join[node],
wait => Wait[node],
ENDCASE => Signal[node]];
SELECT RType[] FROM
CSENull, typeANY => NULL;
ENDCASE => Log.Error[nonVoidStmt];
SetInfo[dataPtr.textIndex]; val ← PopTree[]; RPop[];
pathNP ← SequenceNP[pathNP][phraseNP];
IF OpName[val] = error THEN current.reachable ← FALSE};
xerror => {
subNode: Tree.Index;
IF current.catchDepth # 0 THEN Log.Error[misplacedReturn];
tb[node].name ← error;
val ← MiscStmt[node]; subNode ← GetNode[val];
IF tb[subNode].attr1 THEN Log.ErrorTree[typeClash, val];
SELECT tb[subNode].name FROM
error, errorx => tb[subNode].name ← xerror;
ENDCASE => NULL;
tb[subNode].attr1 ← current.entry; tb[subNode].attr3 ← FALSE;
IF current.entry THEN tb[subNode].attr2 ← CheckLocals[tb[subNode].son[2]];
IF tb[subNode].nSons > 2 THEN Log.Error[misplacedCatch];
current.reachable ← FALSE};
resume => Resume[node];
reject => {
IF current.catchDepth = 0 THEN Log.Error[misplacedResume];
current.reachable ← FALSE};
continue, retry => {
SIGNAL InsertCatchLabel[catchSeen:FALSE, exit:tb[node].name=continue];
current.reachable ← FALSE};
restart => {val ← Restart[node]; pathNP ← SequenceNP[pathNP][phraseNP]};
stop => {
IF dataPtr.bodyIndex # RootBti OR current.catchDepth # 0
OR current.returnRecord # CSENull THEN Log.Error[misplacedStop];
dataPtr.stopping ← TRUE; pathNP ← SetNP[pathNP]};
notify, broadcast => {
OPEN tb[node];
type: Type;
IF ~current.lockHeld THEN Log.Error[misplacedMonitorRef];
son[1] ← Exp[son[1], typeANY];
IF OperandLhs[son[1]] = none THEN Log.ErrorTree[nonLHS, son[1]];
type ← RType[]; RPop[]; pathNP ← SequenceNP[pathNP][phraseNP];
IF ~EqTypes[type, dataPtr.typeCONDITION] THEN
Log.ErrorTreeOp[missingOp, son[1], name]
};
free => {
OPEN tb[node];
type: Type;
subType, nType: CSEIndex;
long, counted: BOOL;
[v: son[1], long: long, counted: counted] ← EvalZone[son[1]]; RPop[];
IF counted AND OpName[son[2]] = addr THEN PutAttr[son[2], 1, TRUE];
son[2] ← Exp[son[2], typeANY]; type ← RType[]; RPop[];
subType ← NormalType[type];
WITH s: seb[subType] SELECT FROM
ref => {
IF s.readOnly THEN Log.ErrorTree[typeClash, son[2]];
IF long # (TypeForm[s.refType] = $long) THEN GO TO fail;
nType ← NormalType[s.refType];
WITH t: seb[nType] SELECT FROM
ref => IF t.counted # counted THEN GO TO fail;
ENDCASE => GO TO fail;
IF P3S.safety = checked AND ~counted THEN
Log.ErrorNode[unsafeOperation, node];
EXITS
fail => Log.ErrorTree[typeClash, son[2]]};
ENDCASE => Log.ErrorTree[typeClash, son[2]];
IF nSons > 3 THEN {
saveNP: NPUse = phraseNP;
[] ← CatchPhrase[son[4]]; phraseNP ← MergeNP[saveNP][phraseNP]};
attr2 ← long; attr3 ← counted;
SELECT TRUE FROM
~counted => attr1 ← FALSE;
(OpName[son[2]] # addr) => {Log.ErrorTree[nonVar, son[2]]; attr1 ← FALSE};
ENDCASE => attr1 ← OperandLhs[NthSon[son[2], 1]] = counted
};
dst, lst, lste, lstf => {
OPEN tb[node];
v: Tree.Link;
v ← son[1] ← Exp[son[1], typeANY]; RPop[];
SELECT name FROM
dst => IF OperandLhs[son[1]] = none THEN GO TO fail;
lst => NULL;
lste => current.noXfers ← FALSE;
lstf => current.reachable ← FALSE;
ENDCASE;
IF name = lste OR name = lstf THEN phraseNP ← SetNP[phraseNP];
pathNP ← SequenceNP[pathNP][phraseNP];
check for simple addressability
DO
WITH v SELECT FROM
symbol => IF seb[index].constant THEN GO TO fail ELSE EXIT;
subtree =>
SELECT tb[index].name FROM
dollar, loophole => v ← tb[index].son[1]
ENDCASE => GO TO fail;
ENDCASE => GO TO fail;
ENDLOOP;
IF P3S.safety = checked THEN Log.ErrorNode[unsafeOperation, node];
EXITS
fail => Log.ErrorTree[nonLHS, tb[node].son[1]]
};
enable => {
OPEN tb[node];
saveEnabled: BOOL = current.unwindEnabled;
IF CatchPhrase[son[1]].unwindCaught THEN current.unwindEnabled ← TRUE;
IF phraseNP # none THEN pathNP ← unsafe;
son[2] ← UpdateList[son[2], Stmt]; attr3 ← FALSE;
current.unwindEnabled ← saveEnabled};
ENDCASE => Log.Error[unimplemented];
RETURN};
dynamic storage allocation
New: PUBLIC PROC[node: Tree.Index, target: Type] = {
OPEN tb[node];
pType: RefSEIndex;
subType: Type;
attr: Attr;
saveNP: NPUse;
long, counted: BOOL;
[v: son[1], long: long, counted: counted] ← EvalZone[son[1]];
attr ← RAttr[]; RPop[]; saveNP ← phraseNP;
current.noXfers ← attr.noXfer ← FALSE; attr.const ← FALSE;
son[2] ← TypeAppl[son[2]];
attr ← And[attr, RAttr[]]; saveNP ← MergeNP[saveNP][phraseNP]; RPop[];
subType ← TypeForTree[son[2]];
IF ~NewableType[subType] THEN Log.ErrorTree[typeLength, son[2]];
IF counted THEN EnterType[TypeRoot[subType], FALSE];
IF son[3] = Tree.Null THEN son[3] ← DefaultInit[subType]
ELSE {
StringInit: PROC[t: Tree.Link] RETURNS[BOOL] = INLINE {
RETURN[SELECT OpName[t] FROM
stringinit => TRUE,
lengthen => (OpName[NthSon[t, 1]] = stringinit),
ENDCASE => FALSE]
};
extFlag: BOOL;
[son[3], extFlag] ← InitialExp[son[3], subType];
SELECT TRUE FROM
extFlag => Log.ErrorTree[misusedInline, son[3]];
StringInit[son[3]] => Log.ErrorTree[defaultForm, son[3]];
ENDCASE};
attr ← And[attr, RAttr[]]; phraseNP ← SequenceNP[saveNP][phraseNP]; RPop[];
pType ← MakeRefType[
cType: subType, readOnly: tb[node].attr1, counted: counted,
hint: NormalType[target]];
IF counted AND son[3] # Tree.Null THEN
EnterComposite[UnderType[subType], son[3], TRUE];
IF son[3] = Tree.Null AND ~Voidable[subType] THEN Log.ErrorNode[missingInit, node];
IF nSons > 3 THEN {
saveNP: NPUse = phraseNP;
[] ← CatchPhrase[son[4]]; phraseNP ← MergeNP[saveNP][phraseNP]};
attr2 ← long; attr3 ← counted;
RPush[IF long THEN MakeLongType[pType, target] ELSE pType, attr]};
EvalZone: PROC[t: Tree.Link] RETURNS[v: Tree.Link, long, counted: BOOL] = {
type: Type;
nType: CSEIndex;
nDerefs: CARDINAL;
long ← counted ← TRUE;
IF t = Tree.Null THEN {v ← Tree.Null; RPush[typeANY, fullAttr]}
ELSE {
v ← Exp[t, typeANY]; type ← RType[]; nDerefs ← 0;
DO
nType ← NormalType[type];
WITH s: seb[nType] SELECT FROM
zone => {long ← ~s.mds; counted ← s.counted; GO TO success};
ref => {
IF (nDerefs ← nDerefs + 1) > 63 THEN GO TO failure;
PushTree[v]; PushNode[uparrow, 1]; SetAttr[2, TypeForm[type] = $long];
type ← s.refType; SetInfo[type]; v ← PopTree[]};
record =>
IF Bundling[nType] # 0 THEN type ← Unbundle[LOOPHOLE[nType, RecordSEIndex]]
ELSE GO TO failure;
ENDCASE => GO TO failure;
REPEAT
success => NULL;
failure => Log.ErrorTree[typeClash, v];
ENDLOOP};
RETURN};
list allocation
Cons: PUBLIC PROC[node: Tree.Index, target: Type] RETURNS[Tree.Link] = {
nType: Type = ReferentType[ListType[target, [subtree[node]]]];
PushTree[tb[node].son[1]]; tb[node].son[1] ← Tree.Null;
PushNode[implicitTC, 0]; SetInfo[UnderType[nType]];
CheckLength[tb[node].son[2], 2];
PushTree[tb[node].son[2]]; tb[node].son[2] ← Tree.Null;
PushTree[Tree.Null]; PushNode[apply, -2]; SetAttr[1, FALSE];
IF tb[node].nSons > 2 THEN {
PushTree[tb[node].son[3]]; tb[node].son[3] ← Tree.Null; PushNode[new, 4]}
ELSE PushNode[new, 3];
FreeNode[node];
RETURN[Exp[PopTree[], target]]};
ListCons: PUBLIC PROC[node: Tree.Index, target: Type] = {
lType: CSEIndex = ListType[target, [subtree[node]]];
nType: Type = ReferentType[lType];
componentType: Type = ItemType[nType];
cType: Type = TargetType[componentType];
attr: Attr;
exitNP: NPUse;
long, counted: BOOL;
started: BOOLFALSE;
MapValue: Tree.Map = {
type: Type;
subAttr: Attr;
IF ~started AND KeyedList[t] THEN Log.Error[keys];
v ← SELECT TRUE FROM
(t = Tree.Null) => DefaultInit[componentType],
(OpName[t] = void) => FieldVoid[t],
ENDCASE => Rhs[t, cType];
subAttr ← RAttr[]; type ← RType[]; RPop[];
IF v = Tree.Null THEN VoidComponent[componentType]
ELSE IF counted THEN EnterComposite[UnderType[componentType], v, TRUE];
IF P3S.safety = checked AND TypeForm[type] = $transfer THEN
v ← CheckScope[v, type];
exitNP ← MergeNP[exitNP][phraseNP]; attr ← And[attr, subAttr];
started ← TRUE; RETURN};
[v: tb[node].son[1], long: long, counted: counted] ← EvalZone[tb[node].son[1]];
attr ← RAttr[]; RPop[]; exitNP ← phraseNP;
current.noXfers ← attr.noXfer ← FALSE; attr.const ← FALSE;
IF counted THEN EnterType[TypeRoot[nType], FALSE];
tb[node].son[2] ← ReverseUpdateList[tb[node].son[2], MapValue];
tb[node].attr2 ← long; tb[node].attr3 ← counted;
RPush[lType, attr]; phraseNP ← exitNP;
RETURN};
ListType: PROC[target: Type, t: Tree.Link] RETURNS[lType: CSEIndex] = {
subType: CSEIndex = NormalType[target];
WITH r: seb[subType] SELECT FROM
ref => {
rType: CSEIndex = UnderType[r.refType];
IF ~r.list AND (seb[rType].typeTag = any OR rType = typeANY) THEN
lType ← dataPtr.typeListANY
ELSE {
IF ~r.list THEN Log.ErrorTree[typeClash, t];
lType ← UnderType[target]}};
ENDCASE =>
IF subType = typeANY THEN lType ← dataPtr.typeListANY
ELSE {Log.ErrorTree[typeClash, t]; lType ← typeANY};
RETURN};
ItemType: PUBLIC PROC[nType: Type] RETURNS[Type] = {
sei: CSEIndex = UnderType[nType];
RETURN[WITH r: seb[sei] SELECT FROM
record => seb[FirstCtxSe[r.fieldCtx]].idType,
ENDCASE => typeANY]
};
control transfers
MiscXfer: PUBLIC PROC[node: Tree.Index, target: Type] RETURNS[val: Tree.Link] = {
SELECT tb[node].name FROM
signalx, errorx => val ← Signal[node];
create => val ← Create[node, target];
startx => val ← Start[node];
fork => val ← Fork[node, target];
joinx => val ← Join[node];
ENDCASE => {Log.Error[unimplemented]; val ← [subtree[node]]};
RETURN};
MakeFrameRecord: PUBLIC PROC[t: Tree.Link] RETURNS[rSei: CSEIndex] = {
bti: CBTIndex = XferBody[t];
IF bti # CBTNull THEN {
argType: Type = TransferTypes[bb[bti].ioType].typeIn;
rSei ← IF bb[bti].type # RecordSENull AND argType = nullType
THEN bb[bti].type
ELSE AllocFrameRecord[bti, argType]}
ELSE {Log.Error[nonTypeCons]; rSei ← typeANY};
RETURN};
AllocFrameRecord: PROC[bti: CBTIndex, link: Type] RETURNS[sei: RecordSEIndex] = {
sei ← LOOPHOLE[MakeNonCtxSe[SERecord.cons.record.linked.SIZE]];
seb[sei] ← SERecord[mark3: TRUE, mark4: FALSE,
body: cons[record[
machineDep: FALSE,
painted: TRUE, argument: FALSE,
hints: [
unifield: FALSE, variant: FALSE,
assignable: FALSE, comparable: FALSE, privateFields: TRUE,
refField: TRUE, default: FALSE, voidable: FALSE],
fieldCtx: bb[bti].localCtx,
length: IF bb[bti].type # RecordSENull THEN seb[bb[bti].type].length ELSE 0,
monitored: bb[bti].monitored,
linkPart: linked[link]]]];
RETURN};
XferBody: PROC[t: Tree.Link] RETURNS[bti: CBTIndex] = {
WITH t SELECT FROM
symbol => {
sei: ISEIndex = index;
type: Type = seb[sei].idType;
bti ← SELECT TypeForm[type] FROM
$transfer =>
IF ~seb[sei].immutable
THEN CBTNull
ELSE
SELECT XferMode[type] FROM
$program =>
IF seb[sei].mark4
THEN (IF seb[sei].constant THEN seb[sei].idInfo ELSE CBTNull)
ELSE RootBti,
$proc =>
IF sei = bb[dataPtr.bodyIndex].id THEN dataPtr.bodyIndex ELSE CBTNull,
ENDCASE => CBTNull,
ENDCASE => CBTNull
};
ENDCASE => bti ← CBTNull;
RETURN};
XferForFrame: PUBLIC PROC[ctx: CTXIndex] RETURNS[type: CSEIndex ← CSENull] = {
bti: BTIndex ← BTIndex.FIRST;
btLimit: BTIndex = (dataPtr.table).Top[bodyType];
UNTIL bti = btLimit DO
WITH entry: bb[bti] SELECT FROM
Callable => {
IF entry.localCtx = ctx THEN RETURN[entry.ioType];
bti ← bti + (WITH entry SELECT FROM
Inner => BodyRecord.Callable.Inner.SIZE,
Catch => BodyRecord.Callable.Catch.SIZE,
ENDCASE => BodyRecord.Callable.Outer.SIZE)};
ENDCASE => bti ← bti + BodyRecord.Other.SIZE;
ENDLOOP;
RETURN[CSENull]};
Create: PROC[node: Tree.Index, target: Type] RETURNS[val: Tree.Link] = {
subNode: Tree.Index;
val ← ForceApplication[tb[node].son[1]];
tb[node].son[1] ← Tree.Null; FreeNode[node];
subNode ← GetNode[val];
BEGIN OPEN tb[subNode];
type, mType, rType: CSEIndex;
attr: Attr;
CreateError: PROC = {Log.ErrorTreeOp[missingOp, son[1], create]; type ← typeANY};
name ← create; attr1 ← TRUE;
son[1] ← Exp[son[1], typeANY];
mType ← UType[]; attr ← RAttr[]; RPop[]; phraseNP ← SetNP[phraseNP];
WITH m: seb[mType] SELECT FROM
transfer =>
IF m.mode = program THEN
SELECT XferBody[son[1]] FROM
CBTNull => type ← mType;
RootBti => {
type ← (IF TypeForm[target] = $ref
THEN MakeRefType[MakeFrameRecord[son[1]], target]
ELSE mType);
attr1 ← FALSE};
ENDCASE => CreateError[]
ELSE CreateError[];
ref => {
type ← mType; rType ← UnderType[m.refType];
WITH r: seb[rType] SELECT FROM
record =>
SELECT TRUE FROM
(CtxLevel[r.fieldCtx] # lG) => CreateError[];
(TypeForm[target] = $transfer) => {
type ← XferForFrame[r.fieldCtx];
IF type = CSENull THEN {Log.Error[unimplemented]; type ← typeANY}};
ENDCASE;
ENDCASE => IF m.refType # typeANY THEN CreateError[]};
ENDCASE => IF mType = typeANY THEN type ← typeANY ELSE CreateError[];
IF son[2] # Tree.Null THEN {
Log.ErrorTree[noApplication, son[1]]; son[2] ← UpdateList[son[2], VoidExp]};
IF nSons > 2 THEN [] ← CatchPhrase[son[3]];
current.noXfers ← attr.noXfer ← FALSE; attr.const ← FALSE;
RPush[type, attr];
END;
RETURN};
Start: PROC[node: Tree.Index] RETURNS[Tree.Link] = {
subNode: Tree.Index;
subNode ← Apply[GetNode[ForceApplication[tb[node].son[1]]], typeANY, TRUE];
SELECT tb[subNode].name FROM
start, startx, apply => NULL;
ENDCASE => Log.ErrorTreeOp[missingOp, tb[subNode].son[1], start];
tb[node].son[1] ← Tree.Null; FreeNode[node];
RETURN[[subtree[subNode]]]};
Restart: PROC[node: Tree.Index] RETURNS[val: Tree.Link] = {
subNode: Tree.Index;
type: Type;
val ← ForceApplication[tb[node].son[1]];
subNode ← GetNode[val];
BEGIN OPEN tb[subNode];
name ← tb[node].name; info ← tb[node].info;
son[1] ← Exp[son[1], typeANY]; type ← RType[]; RPop[];
phraseNP ← SetNP[phraseNP];
SELECT TypeForm[type] FROM
$ref => NULL;  -- a weak check for now
$transfer =>
IF XferMode[type] # $program OR XferBody[son[1]] # CBTNull THEN
Log.ErrorTreeOp[missingOp, son[1], restart];
ENDCASE => IF type # typeANY THEN Log.ErrorTreeOp[missingOp, son[1], restart];
IF son[2] # Tree.Null THEN {
Log.ErrorTree[noApplication, son[1]]; son[2] ← UpdateList[son[2], VoidExp]};
IF nSons > 2 THEN [] ← CatchPhrase[son[3]];
END;
current.noXfers ← FALSE;
tb[node].son[1] ← Tree.Null; FreeNode[node]; RETURN};
Fork: PROC[node: Tree.Index, target: Type] RETURNS[Tree.Link] = {
subNode: Tree.Index;
type: CSEIndex;
attr: Attr;
t: Tree.Link ← ForceApplication[tb[node].son[1]];
tb[node].son[1] ← Tree.Null; FreeNode[node];
subNode ← Apply[GetNode[t], typeANY, TRUE]; attr ← RAttr[]; RPop[];
SELECT tb[subNode].name FROM
call, callx => {
s: Tree.Link ← tb[subNode].son[1];
subType: CSEIndex;
IF OpName[s] = thread THEN {
s ← NthSon[s, 1]; Log.ErrorTree[misusedInline, s]};
IF current.lockHeld AND OperandInternal[s] THEN
Log.ErrorTree[internalCall, s];
subType ← UnderType[OperandType[s]];
WITH procType: seb[subType] SELECT FROM
transfer => {
type ← MakeNonCtxSe[SERecord.cons.transfer.SIZE];
seb[type] ← SERecord[mark3: TRUE, mark4: TRUE,
body: cons[transfer[
mode: process, safe: procType.safe,
typeIn: RecordSENull,
typeOut: procType.typeOut]]];
IF P3S.safety = checked THEN {
CheckArg: Tree.Map = {
argType: Type = OperandType[t];
subType: CSEIndex = NormalType[argType];
WITH s: seb[subType] SELECT FROM
ref => {IF s.var THEN Log.ErrorTreeOp[unsafeOp, t, fork]; v ← t};
transfer => v ← CheckScope[t, argType];
ENDCASE => v ← t;
RETURN};
tb[subNode].son[1] ← CheckScope[s, subType];
tb[subNode].son[2] ← UpdateList[tb[subNode].son[2], CheckArg]}};
ENDCASE => ERROR;
tb[subNode].name ← fork};
apply => type ← typeANY;
ENDCASE => {Log.ErrorTreeOp[missingOp, tb[subNode].son[1], fork]; type ← typeANY};
tb[subNode].info ← type; RPush[type, attr];
RETURN[[subtree[subNode]]]};
Join: PROC[node: Tree.Index] RETURNS[Tree.Link] = {
subNode: Tree.Index;
subNode ← Apply[GetNode[ForceApplication[tb[node].son[1]]], typeANY, TRUE];
SELECT tb[subNode].name FROM
join, joinx => NULL;
apply => NULL;
ENDCASE => Log.ErrorTreeOp[missingOp, tb[subNode].son[1], join];
tb[node].son[1] ← Tree.Null; FreeNode[node];
RETURN[[subtree[subNode]]]};
Wait: PROC[node: Tree.Index] RETURNS[val: Tree.Link] = {
subNode: Tree.Index;
saveNP: NPUse;
IF ~current.lockHeld THEN Log.Error[misplacedMonitorRef];
subNode ← Apply[GetNode[ForceApplication[tb[node].son[1]]], typeANY, TRUE];
SELECT tb[subNode].name FROM
wait => NULL;
apply => NULL;
ENDCASE => Log.ErrorTreeOp[missingOp, tb[subNode].son[1], wait];
tb[node].son[1] ← Tree.Null; FreeNode[node];
IF OperandLhs[tb[subNode].son[1]] = none THEN Log.ErrorTree[nonLHS, tb[subNode].son[1]];
[] ← FreeTree[tb[subNode].son[2]];
saveNP ← phraseNP;
tb[subNode].son[2] ← tb[subNode].son[1]; tb[subNode].son[1] ← CopyLock[];
phraseNP ← MergeNP[saveNP][phraseNP];
RETURN[[subtree[subNode]]]};
monitors
LockVar: PUBLIC PROC[t: Tree.Link] RETURNS[val: Tree.Link] = {
type: Type;
nType: CSEIndex;
desc: ConvertUnsafe.SubString;
sei: ISEIndex;
nDerefs: CARDINAL;
long, b: BOOL;
Dereference: PROC [type: Type] = {
PushTree[val]; PushNode[uparrow, 1]; SetInfo[type]; SetAttr[2, long];
val ← PopTree[]};
val ← Exp[t, typeANY]; long ← LongPath[val];
type ← RType[]; RPop[]; nDerefs ← 0;
DO
IF EqTypes[type, dataPtr.typeLOCK] THEN {
IF nDerefs # 0 THEN Dereference[type]; GO TO success};
type ← TypeRoot[type]; nType ← NormalType[type];
WITH seb[nType] SELECT FROM
record => {
IF monitored THEN {
desc ← ["LOCK"L, 0, ("LOCK"L).length];
[b, sei] ← SearchCtxList[EnterString[desc], fieldCtx];
IF ~b THEN {Log.Error[noAccess]; sei ← dataPtr.seAnon};
PushTree[val]; PushSe[sei];
PushNode[IF nDerefs = 0 THEN dollar ELSE dot, 2];
SetInfo[dataPtr.idLOCK]; SetAttr[2, long]; val ← PopTree[];
GO TO success};
GO TO failure};
ref => {
IF (nDerefs ← nDerefs + 1) > 63 THEN GO TO failure;
long ← TypeForm[type] = $long;
IF nDerefs > 1 THEN Dereference[type];
type ← refType};
ENDCASE => GO TO failure;
REPEAT
success => NULL;
failure => Log.ErrorTreeOp[missingOp, val, lock];
ENDLOOP;
IF OperandLhs[val] = none THEN Log.ErrorTree[nonLHS, val];
RETURN};
FindLockParams: PUBLIC PROC RETURNS[formal, actual: ISEIndex] = {
node: Tree.Index = GetNode[tb[passPtr.lockNode].son[1]];
found: BOOL;
IF node = Tree.NullIndex THEN formal ← actual ← ISENull
ELSE {
formal ← FirstId[node];
IF current.inputRecord = RecordSENull THEN found ← FALSE
ELSE [found, actual] ← SearchCtxList[
seb[formal].hash,
seb[current.inputRecord].fieldCtx];
IF ~found THEN actual ← ISENull};
RETURN};
LambdaApply: PROC[t: Tree.Link, formal, actual: ISEIndex] RETURNS[v: Tree.Link] = {
BindFormal: PROC [sei: ISEIndex] RETURNS [Tree.Link] = {
RETURN[[symbol[index: IF sei = formal THEN actual ELSE sei]]]};
v ← BindTree[t, BindFormal];
[] ← UpdateTreeAttr[v];
RETURN};
CopyLock: PUBLIC PROC RETURNS[val: Tree.Link] = {
formal, actual: ISEIndex;
SELECT TRUE FROM
passPtr.lockNode = Tree.NullIndex => val ← Tree.Null;
tb[current.bodyNode].son[4] # Tree.Null =>
val ← LambdaApply[tb[current.bodyNode].son[4], ISENull, ISENull];
ENDCASE => {
[formal:formal, actual:actual] ← FindLockParams[];
IF formal # ISENull THEN {
IF actual = ISENull THEN {Log.ErrorSei[missingLock, formal]; actual ← dataPtr.seAnon};
IF ~Types.Assignable[
[dataPtr.ownSymbols, UnderType[seb[formal].idType]],
[dataPtr.ownSymbols, UnderType[seb[actual].idType]]] THEN
Log.ErrorSei[typeClash, actual]};
val ← LambdaApply[tb[passPtr.lockNode].son[2], formal, actual]};
RETURN};
signals
Signal: PUBLIC PROC[node: Tree.Index] RETURNS[val: Tree.Link] = {
subNode: Tree.Index;
nodeTag: Tree.NodeName = tb[node].name;
subNode ← Apply[GetNode[ForceApplication[tb[node].son[1]]], typeANY, TRUE];
SELECT tb[subNode].name FROM
signal, signalx => tb[subNode].name ← nodeTag;
error, errorx => {
SELECT nodeTag FROM
signal, signalx => Log.ErrorTreeOp[missingOp, tb[subNode].son[1], nodeTag];
ENDCASE => NULL;
tb[subNode].name ← nodeTag};
apply => NULL;
ENDCASE => Log.ErrorTree[typeClash, tb[subNode].son[1]];
tb[node].son[1] ← Tree.Null; FreeNode[node];
RETURN[[subtree[subNode]]]};
ForceApplication: PROC[t: Tree.Link] RETURNS[Tree.Link] = {
IF OpName[t] = apply THEN RETURN[t];
PushTree[t]; PushTree[Tree.Null];
RETURN[MakeNode[apply, 2]]};
catch phrases
CatchPhrase: PUBLIC PROC[t: Tree.Link] RETURNS[unwindCaught: BOOL] = {
saveReachable: BOOL = current.reachable;
savePathNP: NPUse = pathNP;
saveSafety: Safety = P3S.safety;
enclosingSafe: BOOL = (saveSafety = checked);
entryNP, exitNP: NPUse;
CatchItem: Tree.Scan = {
node: Tree.Index = GetNode[t];
type: CSEIndex ← typeANY;
mixed, safe, error: BOOLFALSE;
saveIndex: SourceMap.Loc = dataPtr.textIndex;
CatchLabel: Tree.Map = {
subType: CSEIndex;
v ← Exp[t, typeANY]; subType ← UnderType[CanonicalType[RType[]]]; RPop[];
entryNP ← SequenceNP[entryNP][phraseNP];
WITH t: seb[subType] SELECT FROM
transfer =>
IF t.mode = signal OR t.mode = error THEN {
IF type = typeANY THEN type ← subType
ELSE IF ~Types.Equivalent[
[dataPtr.ownSymbols, type], [dataPtr.ownSymbols, subType]] THEN
mixed ← TRUE;
IF t.safe THEN safe ← TRUE;
IF t.mode = error THEN error ← TRUE}
ELSE Log.ErrorTree[typeClash, v];
ENDCASE => IF subType # typeANY THEN Log.ErrorTree[typeClash, v];
RETURN};
dataPtr.textIndex ← tb[node].info;
tb[node].son[1] ← UpdateList[tb[node].son[1], CatchLabel];
IF mixed THEN type ← typeANY;
tb[node].son[2] ← CatchBody[
tb[node].son[2], type, safe OR (error AND enclosingSafe)];
IF tb[node].son[1] = Tree.Link[symbol[index: dataPtr.idUNWIND]] THEN {
unwindCaught ← TRUE;
IF current.entry AND ~current.unwindEnabled AND current.catchDepth = 0 THEN {
PushTree[tb[node].son[2]]; PushTree[CopyLock[]];
PushNode[unlock, 1]; SetInfo[dataPtr.textIndex];
tb[node].son[2] ← MakeList[2]}};
tb[node].info ← IF type # typeANY THEN type ELSE nullType;
dataPtr.textIndex ← saveIndex; RETURN};
CatchBody: PROC [body: Tree.Link, type: CSEIndex, safe: BOOL]
RETURNS [val: Tree.Link] = {
saveRecord: RecordSEIndex = current.resumeRecord;
saveFlag: BOOL = current.resumeFlag;
current.catchDepth ← current.catchDepth + 1;
WITH t: seb[type] SELECT FROM
transfer => {
current.resumeFlag ← t.mode = signal;
PushArgCtx[t.typeIn];
BumpArgRefs[ArgRecord[t.typeIn], TRUE];
PushArgCtx[current.resumeRecord ← ArgRecord[t.typeOut]];
ClearRefStack[]};
ENDCASE => {
current.resumeFlag ← FALSE; current.resumeRecord ← RecordSENull};
current.reachable ← TRUE; pathNP ← entryNP;
SELECT OpName[body] FROM
block, checked => SetSafety[SafetyAttr[GetNode[body]]];
ENDCASE;
IF safe AND P3S.safety = none THEN Log.Error[unsafeBlock];
val ← UpdateList[body, Stmt ! InsertCatchLabel => {IF catchSeen THEN RESUME}];
exitNP ← BoundNP[exitNP][pathNP];
WITH t: seb[type] SELECT FROM
transfer => {PopArgCtx[t.typeOut]; PopArgCtx[t.typeIn]};
ENDCASE;
current.catchDepth ← current.catchDepth - 1;
current.resumeRecord ← saveRecord; current.resumeFlag ← saveFlag;
SetSafety[saveSafety]; RETURN};
setLabel, continued: BOOL;
node: Tree.Index = GetNode[t];
SealRefStack[];
setLabel ← continued ← unwindCaught ← FALSE; entryNP ← exitNP ← none;
BEGIN
ENABLE InsertCatchLabel => {
IF ~catchSeen THEN {
setLabel ← TRUE; IF exit THEN continued ← TRUE;
SIGNAL InsertCatchLabel[catchSeen:TRUE, exit:exit]; RESUME}};
ScanList[tb[node].son[1], CatchItem];
IF tb[node].nSons > 1 THEN
tb[node].son[2] ← CatchBody[tb[node].son[2], typeANY, enclosingSafe];
END;
IF setLabel THEN {P3S.markCatch ← TRUE; P3S.continued ← continued};
UnsealRefStack[]; current.reachable ← saveReachable;
phraseNP ← exitNP; pathNP ← savePathNP; RETURN};
PushArgCtx: PROC[sei: CSEIndex] = {
ctx: CTXIndex = ArgCtx[sei];
IF ctx # CTXNull THEN {
SetCtxLevel[ctx, current.level + current.catchDepth]; PushCtx[ctx]}
};
PopArgCtx: PROC[sei: CSEIndex] = {
ctx: CTXIndex = ArgCtx[sei];
IF ctx # CTXNull THEN {PopCtx[]; SetCtxLevel[ctx, lZ]}};
Resume: PROC[node: Tree.Index] = {
OPEN tb[node];
rSei: RecordSEIndex = current.resumeRecord;
IF ~current.resumeFlag THEN Log.Error[misplacedResume];
IF rSei # RecordSENull AND son[1] = Tree.Null THEN {
n: CARDINAL ← 0;
BumpArgRefs[rSei, FALSE];
FOR sei: ISEIndex ← FirstCtxSe[seb[rSei].fieldCtx], NextSe[sei] UNTIL sei = ISENull DO
n ← n+1;
IF n=1 AND seb[sei].hash = HTNull THEN Log.Error[illDefinedReturn];
PushSe[sei];
ENDLOOP;
son[1] ← MakeList[n]}
ELSE {
son[1] ← IF attr1 AND rSei # RecordSENull
THEN Rhs[son[1], rSei]
ELSE MatchFields[rSei, son[1]];
RPop[];
pathNP ← SequenceNP[pathNP][phraseNP]};
current.reachable ← FALSE};
Rope identification (temporary)
CheckHash: PROC[hti: HTIndex, s: LONG STRING] RETURNS[BOOL] = {
desc: ConvertUnsafe.SubString;
desc ← [base: s, offset: 0, length: s.length];
RETURN[FindString[desc] = hti]};
TextRep: PUBLIC PROC[rType: Type] RETURNS[form: TextForm ← text] = {
type: CSEIndex = UnderType[rType];
rope: STRING = "Rope"L;
ropeRep: STRING = "RopeRep"L;
textRep: STRING = "TextRep"L;
WITH se: seb[rType] SELECT FROM
id =>
IF CheckHash[se.hash, ropeRep] THEN form ← $rope
ELSE IF CheckHash[se.hash, textRep] THEN form ← $ropeText;
ENDCASE;
WITH t: seb[type] SELECT FROM
record =>
WITH c: ctxb[t.fieldCtx] SELECT FROM
included => IF ~CheckHash[mdb[c.module].moduleId, rope] THEN form ← $text;
ENDCASE => form ← $text;
ENDCASE => form ← $text;
RETURN};
}.