-- file Pass3M.Mesa
-- last modified by Satterthwaite, November 12, 1979 4:38 PM
DIRECTORY
ComData: FROM "comdata"
USING [
bodyIndex, idUNWIND, mainBody, ownSymbols, seAnon, stopping,
textIndex, typeCONDITION, typeLOCK],
Log: FROM "log" USING [Error, ErrorSei, ErrorTree],
Pass3: FROM "pass3"
USING [continued, currentBody, lockHeld, lockNode, markCatch],
P3: FROM "p3"
USING [
Attr, BodyData, NPUse, BoundNP, MergeNP, SequenceNP, SetNP,
pathNP, phraseNP,
Apply, BumpArgRefs, BumpCount, CanonicalType, CheckLocals,
ClearRefStack, Exp, LongPath, MakePointerType, MatchFields,
OperandInline, OperandInternal, OperandLhs, OperandType,
PopCtx, PushCtx, RAttr, RPop, RPush, RType, SealRefStack,
SearchCtxList, Stmt, UnsealRefStack, UpdateTreeAttr, VoidExp],
StringDefs: FROM "stringdefs" USING [SubStringDescriptor],
Symbols: FROM "symbols"
USING [seType, ctxType, mdType, bodyType,
SERecord, BodyRecord,
SEIndex, ISEIndex, CSEIndex, RecordSEIndex,
CTXIndex, BTIndex, CBTIndex,
HTNull, SENull, ISENull, CSENull, RecordSENull, CBTNull,
lG, lZ, typeANY],
SymbolOps: FROM "symbolops"
USING [
EnterString, MakeNonCtxSe, NextSe, NormalType,
TransferTypes, TypeRoot, UnderType, XferMode],
Table: FROM "table" USING [Base, Notifier, Bounds],
Tree: FROM "tree"
USING [treeType,
Index, Link, Map, NodeName, Null, NullIndex, Scan],
TreeOps: FROM "treeops"
USING [
CopyTree, FreeNode, FreeTree, GetNode, MakeList, MakeNode,
PopTree, PushTree, PushSe, PushNode, ScanList, SetAttr, SetInfo,
Shared, TestTree, UpdateList],
Types: FROM "types" USING [Assignable, Equivalent];
Pass3M: PROGRAM
IMPORTS
Log, P3, SymbolOps, Table, TreeOps, Types,
dataPtr: ComData, passPtr: Pass3
EXPORTS P3 =
BEGIN
OPEN SymbolOps, Symbols, P3, TreeOps;
InsertCatchLabel: PUBLIC SIGNAL [catchSeen, exit: BOOLEAN] = CODE;
tb: Table.Base; -- tree base address (local copy)
seb: Table.Base; -- se table base address (local copy)
ctxb: Table.Base; -- context table base (local copy)
mdb: Table.Base; -- module table base (local copy)
bb: Table.Base; -- body table base (local copy)
MiscNotify: PUBLIC Table.Notifier =
BEGIN -- called by allocator whenever table area is repacked
tb ← base[Tree.treeType];
seb ← base[seType]; ctxb ← base[ctxType]; mdb ← base[mdType];
bb ← base[bodyType];
END;
current: POINTER TO P3.BodyData = @passPtr.currentBody;
-- statements
MiscStmt: PUBLIC PROCEDURE [node: Tree.Index] RETURNS [val: Tree.Link] =
BEGIN
val ← [subtree[index: node]]; -- the default
SELECT tb[node].name FROM
signal, error, start, join, wait =>
BEGIN
IF tb[node].name = xerror AND current.catchDepth # 0
THEN Log.Error[misplacedReturn];
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 TestTree[val, error] THEN current.reachable ← FALSE;
END;
xerror =>
BEGIN
subNode: Tree.Index;
IF current.catchDepth # 0 THEN Log.Error[misplacedReturn];
tb[node].name ← error;
val ← MiscStmt[node]; subNode ← GetNode[val];
SELECT tb[subNode].name FROM
error, errorx => tb[subNode].name ← xerror;
ENDCASE => NULL;
tb[subNode].attr1 ← current.entry;
IF current.entry
THEN tb[subNode].attr2 ← CheckLocals[tb[subNode].son[2]];
current.reachable ← FALSE;
END;
resume => Resume[node];
continue, retry =>
BEGIN
SIGNAL InsertCatchLabel[catchSeen:FALSE, exit:tb[node].name=continue];
current.reachable ← FALSE;
END;
restart =>
BEGIN val ← Restart[node]; pathNP ← SequenceNP[pathNP][phraseNP] END;
stop =>
BEGIN
IF dataPtr.bodyIndex # dataPtr.mainBody OR current.catchDepth # 0
OR current.returnRecord # SENull
THEN Log.Error[misplacedStop];
IF tb[node].son[1] # Tree.Null THEN [] ← CatchPhrase[tb[node].son[1]];
dataPtr.stopping ← TRUE; pathNP ← SetNP[pathNP];
END;
notify, broadcast =>
BEGIN OPEN tb[node];
type: CSEIndex;
IF ~passPtr.lockHeld THEN Log.Error[misplacedMonitorRef];
son[1] ← Exp[son[1], typeANY];
IF ~OperandLhs[son[1]] THEN Log.ErrorTree[nonLHS, son[1]];
type ← RType[]; RPop[]; pathNP ← SequenceNP[pathNP][phraseNP];
IF type # dataPtr.typeCONDITION THEN Log.ErrorTree[typeClash, son[1]];
END;
dst, lst, lstf =>
BEGIN OPEN tb[node];
v: Tree.Link;
v ← son[1] ← Exp[son[1], typeANY]; RPop[];
SELECT name FROM
lstf => current.reachable ← FALSE;
dst => IF ~OperandLhs[son[1]] THEN GO TO fail;
ENDCASE;
IF name # dst 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 =>
BEGIN
IF tb[index].name # dollar THEN GO TO fail;
v ← tb[index].son[1]
END;
ENDCASE => GO TO fail;
ENDLOOP;
EXITS
fail => Log.ErrorTree[nonLHS, tb[node].son[1]];
END;
enable =>
BEGIN OPEN tb[node];
saveEnabled: BOOLEAN = current.unwindEnabled;
IF CatchPhrase[son[1]].unwindCaught THEN current.unwindEnabled ← TRUE;
IF phraseNP # none THEN pathNP ← unsafe;
son[2] ← UpdateList[son[2], Stmt];
current.unwindEnabled ← saveEnabled;
END;
ENDCASE => Log.Error[unimplemented];
RETURN
END;
-- control transfers
MiscXfer: PUBLIC PROCEDURE [node: Tree.Index, target: CSEIndex] RETURNS [val: Tree.Link] =
BEGIN
SELECT tb[node].name FROM
signalx, errorx => val ← Signal[node];
new => val ← New[node, target];
startx => val ← Start[node];
fork => val ← Fork[node, target];
joinx => val ← Join[node];
ENDCASE => BEGIN Log.Error[unimplemented]; val ← [subtree[node]] END;
RETURN
END;
MakeFrameRecord: PUBLIC PROCEDURE [t: Tree.Link] RETURNS [rSei: CSEIndex] =
BEGIN
bti: CBTIndex = XferBody[t];
IF bti # CBTNull
THEN
rSei ← AllocFrameRecord[bti, TransferTypes[bb[bti].ioType].typeIn]
ELSE BEGIN Log.Error[nonTypeCons]; rSei ← typeANY END;
RETURN
END;
AllocFrameRecord: PROCEDURE [bti: CBTIndex, link: SEIndex] RETURNS [sei: RecordSEIndex] =
BEGIN
sei ← LOOPHOLE[MakeNonCtxSe[SIZE[linked record cons SERecord]]];
seb[sei] ← SERecord[mark3: TRUE, mark4: FALSE,
body: cons[record[
machineDep: FALSE,
argument: FALSE,
hints: [
unifield: FALSE, variant: FALSE,
comparable: FALSE, privateFields: TRUE],
fieldCtx: bb[bti].localCtx,
length: 0 -- n*wordlength --,
lengthUsed: FALSE,
monitored: bb[bti].monitored,
linkPart: linked[link]]]];
RETURN
END;
XferBody: PROCEDURE [t: Tree.Link] RETURNS [bti: CBTIndex] =
BEGIN
sei: ISEIndex;
type: CSEIndex;
WITH t SELECT FROM
symbol =>
BEGIN sei ← index;
type ← UnderType[seb[sei].idType];
bti ← WITH seb[type] SELECT FROM
transfer =>
IF ~seb[sei].immutable
THEN CBTNull
ELSE
SELECT mode FROM
program =>
IF seb[sei].mark4
THEN
IF seb[sei].constant THEN seb[sei].idInfo ELSE CBTNull
ELSE dataPtr.mainBody,
procedure =>
IF sei = bb[dataPtr.bodyIndex].id
THEN dataPtr.bodyIndex
ELSE CBTNull,
ENDCASE => CBTNull,
ENDCASE => CBTNull;
END;
ENDCASE => bti ← CBTNull;
RETURN
END;
XferForFrame: PUBLIC PROCEDURE [ctx: CTXIndex] RETURNS [CSEIndex] =
BEGIN
bti: BTIndex;
btLimit: BTIndex = LOOPHOLE[Table.Bounds[bodyType].size];
bti ← FIRST[BTIndex];
UNTIL bti = btLimit
DO
WITH entry: bb[bti] SELECT FROM
Callable =>
BEGIN
IF entry.localCtx = ctx THEN RETURN [UnderType[entry.ioType]];
bti ← bti + (WITH entry SELECT FROM
Inner => SIZE[Inner Callable BodyRecord],
ENDCASE => SIZE[Outer Callable BodyRecord]);
END;
ENDCASE => bti ← bti + SIZE[Other BodyRecord];
ENDLOOP;
ERROR
END;
New: PROCEDURE [node: Tree.Index, target: CSEIndex] RETURNS [val: Tree.Link] =
BEGIN
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;
NewError: PROCEDURE =
BEGIN Log.ErrorTree[typeClash, son[1]]; type ← typeANY END;
name ← new; attr1 ← TRUE;
son[1] ← Exp[son[1], typeANY];
mType ← RType[]; attr ← RAttr[]; RPop[]; phraseNP ← SetNP[phraseNP];
WITH seb[mType] SELECT FROM
transfer =>
IF mode = program
THEN
SELECT XferBody[son[1]] FROM
CBTNull => type ← mType;
dataPtr.mainBody =>
BEGIN
type ← IF seb[target].typeTag = pointer
THEN MakePointerType[MakeFrameRecord[son[1]], target]
ELSE mType;
attr1 ← FALSE;
END;
ENDCASE => NewError[]
ELSE NewError[];
pointer =>
BEGIN
type ← mType; dereferenced ← TRUE; rType ← UnderType[refType];
WITH seb[rType] SELECT FROM
record =>
SELECT TRUE FROM
(ctxb[fieldCtx].level # lG) => NewError[];
(seb[target].typeTag = transfer) =>
type ← XferForFrame[fieldCtx];
ENDCASE;
ENDCASE => IF refType # typeANY THEN NewError[];
END;
ENDCASE => IF mType # typeANY THEN type ← typeANY ELSE NewError[];
IF son[2] # Tree.Null
THEN
BEGIN Log.ErrorTree[noApplication, son[1]];
son[2] ← UpdateList[son[2], VoidExp];
END;
IF nSons > 2 THEN [] ← CatchPhrase[son[3]];
attr.const ← attr.noXfer ← FALSE; RPush[type, attr];
END;
RETURN
END;
Start: PROCEDURE [node: Tree.Index] RETURNS [val: Tree.Link] =
BEGIN
subNode: Tree.Index;
val ← ForceApplication[tb[node].son[1]];
subNode ← GetNode[val];
Apply[subNode, typeANY, TRUE];
SELECT tb[subNode].name FROM
start, startx, apply => NULL;
ENDCASE => Log.ErrorTree[typeClash, tb[subNode].son[1]];
tb[node].son[1] ← Tree.Null; FreeNode[node]; RETURN
END;
Restart: PROCEDURE [node: Tree.Index] RETURNS [val: Tree.Link] =
BEGIN
subNode: Tree.Index;
type: CSEIndex;
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];
WITH seb[type] SELECT FROM
pointer => NULL; -- a weak check for now
transfer =>
IF mode # program OR XferBody[son[1]] # CBTNull
THEN Log.ErrorTree[typeClash, son[1]];
ENDCASE => IF type # typeANY THEN Log.ErrorTree[typeClash, son[1]];
IF son[2] # Tree.Null
THEN
BEGIN Log.ErrorTree[noApplication, son[1]];
son[2] ← UpdateList[son[2], VoidExp];
END;
IF nSons > 2 THEN [] ← CatchPhrase[son[3]];
END;
tb[node].son[1] ← Tree.Null; FreeNode[node]; RETURN
END;
Fork: PROCEDURE [node: Tree.Index, target: CSEIndex] RETURNS [val: Tree.Link] =
BEGIN
subNode: Tree.Index;
type, subType: CSEIndex;
attr: Attr;
val ← ForceApplication[tb[node].son[1]];
tb[node].son[1] ← Tree.Null; FreeNode[node];
subNode ← GetNode[val];
Apply[subNode, typeANY, TRUE]; attr ← RAttr[]; RPop[];
SELECT tb[subNode].name FROM
call, callx =>
BEGIN
IF passPtr.lockHeld AND OperandInternal[tb[subNode].son[1]]
THEN Log.ErrorTree[internalCall, tb[subNode].son[1]];
subType ← OperandType[tb[subNode].son[1]];
WITH procType: seb[subType] SELECT FROM
transfer =>
BEGIN
type ← MakeNonCtxSe[SIZE[transfer cons SERecord]];
seb[type] ← SERecord[mark3: TRUE, mark4: TRUE,
body: cons[transfer[
mode: process,
inRecord: RecordSENull,
outRecord: procType.outRecord]]];
IF OperandInline[tb[subNode].son[1]]
THEN Log.ErrorTree[misusedInline, tb[subNode].son[1]];
END;
ENDCASE => ERROR;
tb[subNode].name ← fork;
END;
apply => type ← typeANY;
ENDCASE =>
BEGIN
Log.ErrorTree[typeClash, tb[node].son[1]]; type ← typeANY;
END;
tb[subNode].info ← type;
attr.const ← attr.noXfer ← FALSE; RPush[type, attr];
RETURN
END;
Join: PROCEDURE [node: Tree.Index] RETURNS [val: Tree.Link] =
BEGIN
subNode: Tree.Index;
val ← ForceApplication[tb[node].son[1]];
subNode ← GetNode[val];
Apply[subNode, typeANY, TRUE];
SELECT tb[subNode].name FROM
join, joinx => NULL;
apply => NULL;
ENDCASE => Log.ErrorTree[typeClash, tb[subNode].son[1]];
tb[node].son[1] ← Tree.Null; FreeNode[node]; RETURN
END;
Wait: PROCEDURE [node: Tree.Index] RETURNS [val: Tree.Link] =
BEGIN
subNode: Tree.Index;
saveNP: NPUse;
IF ~passPtr.lockHeld THEN Log.Error[misplacedMonitorRef];
val ← ForceApplication[tb[node].son[1]];
subNode ← GetNode[val];
Apply[subNode, typeANY, TRUE];
SELECT tb[subNode].name FROM
wait => NULL;
apply => NULL;
ENDCASE => Log.ErrorTree[typeClash, tb[subNode].son[1]];
tb[node].son[1] ← Tree.Null; FreeNode[node];
IF ~OperandLhs[tb[subNode].son[1]]
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
END;
-- monitors
LockVar: PUBLIC PROCEDURE [t: Tree.Link] RETURNS [val: Tree.Link] =
BEGIN
type, nType: CSEIndex;
desc: StringDefs.SubStringDescriptor;
sei: ISEIndex;
nDerefs: CARDINAL;
long, b: BOOLEAN;
Dereference: PROCEDURE [type: CSEIndex] =
BEGIN
PushTree[val]; PushNode[uparrow, 1]; SetInfo[type]; SetAttr[1, long];
val ← PopTree[];
END;
val ← Exp[t, typeANY]; long ← LongPath[val];
type ← RType[]; RPop[]; nDerefs ← 0;
DO
IF type = dataPtr.typeLOCK
THEN
BEGIN
IF nDerefs # 0 THEN Dereference[type];
GO TO success
END;
type ← TypeRoot[type]; nType ← NormalType[type];
WITH seb[nType] SELECT FROM
record =>
BEGIN
IF monitored
THEN
BEGIN
desc ← ["LOCK"L, 0, ("LOCK"L).length];
[b, sei] ← SearchCtxList[EnterString[@desc], fieldCtx];
IF ~b THEN BEGIN Log.Error[noAccess]; sei ← dataPtr.seAnon END;
PushTree[val]; PushSe[sei];
PushNode[IF nDerefs = 0 THEN dollar ELSE dot, 2];
SetInfo[dataPtr.typeLOCK]; SetAttr[1, long]; val ← PopTree[];
GO TO success;
END;
GO TO failure;
END;
pointer =>
BEGIN
IF (nDerefs ← nDerefs + 1) > 255 THEN GO TO failure;
IF nDerefs > 1 THEN Dereference[type];
long ← seb[type].typeTag = long;
dereferenced ← TRUE; type ← UnderType[refType];
END;
ENDCASE => GO TO failure;
REPEAT
success => NULL;
failure => Log.ErrorTree[typeClash, val];
ENDLOOP;
IF ~OperandLhs[val] THEN Log.ErrorTree[nonLHS, val];
RETURN
END;
FindLockParams: PUBLIC PROCEDURE RETURNS [formal, actual: ISEIndex] =
BEGIN
node: Tree.Index = GetNode[tb[passPtr.lockNode].son[1]];
found: BOOLEAN;
IF node = Tree.NullIndex
THEN formal ← actual ← ISENull
ELSE
BEGIN
WITH tb[node].son[1] SELECT FROM
symbol => formal ← index;
ENDCASE => ERROR;
IF current.inputRecord = SENull
THEN found ← FALSE
ELSE [found, actual] ← SearchCtxList[
seb[formal].hash,
seb[current.inputRecord].fieldCtx];
IF ~found THEN actual ← ISENull;
END;
RETURN
END;
LambdaApply: PROCEDURE [t: Tree.Link, formal, actual: ISEIndex] RETURNS [Tree.Link] =
BEGIN
Substitute: Tree.Map =
BEGIN
sei: ISEIndex;
WITH t SELECT FROM
symbol =>
BEGIN sei ← index;
IF sei = formal THEN sei ← actual;
BumpCount[sei];
v ← [symbol[index: sei]];
END;
subtree =>
IF Shared[t]
THEN BEGIN [] ← UpdateTreeAttr[t]; v ← t END
ELSE v ← CopyTree[[baseP:@tb, link:t], Substitute];
ENDCASE => v ← t;
RETURN
END;
RETURN [Substitute[t]];
END;
CopyLock: PUBLIC PROCEDURE RETURNS [val: Tree.Link] =
BEGIN
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 =>
BEGIN
[formal:formal, actual:actual] ← FindLockParams[];
IF formal # SENull
THEN
BEGIN
IF actual = SENull
THEN
BEGIN
Log.ErrorSei[missingLock, formal];
actual ← dataPtr.seAnon;
END;
IF ~Types.Assignable[
[dataPtr.ownSymbols, UnderType[seb[formal].idType]],
[dataPtr.ownSymbols, UnderType[seb[actual].idType]]]
THEN Log.ErrorSei[typeClash, actual];
END;
val ← LambdaApply[tb[passPtr.lockNode].son[2], formal, actual];
END;
RETURN
END;
-- signals
Signal: PUBLIC PROCEDURE [node: Tree.Index] RETURNS [val: Tree.Link] =
BEGIN
subNode: Tree.Index;
nodeTag: Tree.NodeName = tb[node].name;
val ← ForceApplication[tb[node].son[1]];
subNode ← GetNode[val];
Apply[subNode, typeANY, TRUE];
SELECT tb[subNode].name FROM
signal, signalx => tb[subNode].name ← nodeTag;
error, errorx =>
BEGIN
SELECT nodeTag FROM
signal, signalx => Log.ErrorTree[typeClash, tb[subNode].son[1]];
ENDCASE => NULL;
tb[subNode].name ← nodeTag;
END;
apply => NULL;
ENDCASE => Log.ErrorTree[typeClash, tb[subNode].son[1]];
tb[node].son[1] ← Tree.Null; FreeNode[node]; RETURN
END;
ForceApplication: PROCEDURE [t: Tree.Link] RETURNS [Tree.Link] =
BEGIN
IF TestTree[t, apply] THEN RETURN [t];
PushTree[t]; PushTree[Tree.Null];
RETURN [MakeNode[apply, 2]]
END;
-- catch phrases
CatchPhrase: PUBLIC PROCEDURE [t: Tree.Link] RETURNS [unwindCaught: BOOLEAN] =
BEGIN
saveReachable: BOOLEAN = current.reachable;
savePathNP: NPUse = pathNP;
entryNP, exitNP: NPUse;
CatchItem: Tree.Scan =
BEGIN
node: Tree.Index = GetNode[t];
type: CSEIndex;
mixed: BOOLEAN;
saveIndex: CARDINAL = dataPtr.textIndex;
CatchLabel: Tree.Map =
BEGIN
subType: CSEIndex;
v ← Exp[t, typeANY]; subType ← CanonicalType[RType[]]; RPop[];
entryNP ← SequenceNP[entryNP][phraseNP];
SELECT XferMode[subType] FROM
signal, error =>
IF type = typeANY
THEN type ← subType
ELSE IF ~Types.Equivalent[
[dataPtr.ownSymbols, type], [dataPtr.ownSymbols, subType]]
THEN mixed ← TRUE;
ENDCASE => IF subType # typeANY THEN Log.ErrorTree[typeClash, t];
RETURN
END;
dataPtr.textIndex ← tb[node].info;
type ← typeANY; mixed ← FALSE;
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];
IF tb[node].son[1] = Tree.Link[symbol[index: dataPtr.idUNWIND]]
THEN
BEGIN
unwindCaught ← TRUE;
IF current.entry AND ~current.unwindEnabled
AND current.catchDepth = 0
THEN
BEGIN
PushTree[tb[node].son[2]]; PushTree[CopyLock[]];
PushNode[unlock, 1]; SetInfo[dataPtr.textIndex];
tb[node].son[2] ← MakeList[2];
END;
END;
tb[node].info ← IF type # typeANY THEN type ELSE SENull;
dataPtr.textIndex ← saveIndex; RETURN
END;
CatchBody: PROCEDURE [body: Tree.Link, type: CSEIndex] RETURNS [val: Tree.Link] =
BEGIN
saveRecord: RecordSEIndex = current.resumeRecord;
saveFlag: BOOLEAN = current.resumeFlag;
current.catchDepth ← current.catchDepth + 1;
WITH seb[type] SELECT FROM
transfer =>
BEGIN current.resumeFlag ← mode = signal;
PushArgCtx[inRecord];
BumpArgRefs[inRecord, TRUE];
PushArgCtx[current.resumeRecord ← outRecord];
ClearRefStack[];
END;
ENDCASE =>
BEGIN
current.resumeFlag ← FALSE; current.resumeRecord ← RecordSENull;
END;
current.reachable ← TRUE; pathNP ← entryNP;
val ← UpdateList[body, Stmt
! InsertCatchLabel => IF catchSeen THEN RESUME];
exitNP ← BoundNP[exitNP][pathNP];
WITH seb[type] SELECT FROM
transfer => BEGIN PopArgCtx[outRecord]; PopArgCtx[inRecord] END;
ENDCASE;
current.catchDepth ← current.catchDepth - 1;
current.resumeRecord ← saveRecord; current.resumeFlag ← saveFlag;
RETURN
END;
setLabel, continued: BOOLEAN;
node: Tree.Index = GetNode[t];
SealRefStack[];
setLabel ← continued ← unwindCaught ← FALSE; entryNP ← exitNP ← none;
BEGIN
ENABLE InsertCatchLabel =>
IF ~catchSeen
THEN
BEGIN
setLabel ← TRUE; IF exit THEN continued ← TRUE;
SIGNAL InsertCatchLabel[catchSeen:TRUE, exit:exit]; RESUME
END;
ScanList[tb[node].son[1], CatchItem];
IF tb[node].nSons > 1
THEN tb[node].son[2] ← CatchBody[tb[node].son[2], typeANY];
END;
IF setLabel
THEN BEGIN passPtr.markCatch ← TRUE; passPtr.continued ← continued END;
UnsealRefStack[]; current.reachable ← saveReachable;
phraseNP ← exitNP; pathNP ← savePathNP; RETURN
END;
PushArgCtx: PROCEDURE [rSei: RecordSEIndex] =
BEGIN
ctx: CTXIndex;
IF rSei # RecordSENull THEN
BEGIN
ctx ← seb[rSei].fieldCtx;
ctxb[ctx].level ← current.level + current.catchDepth; PushCtx[ctx];
END;
END;
PopArgCtx: PROCEDURE [rSei: RecordSEIndex] =
BEGIN
IF rSei # RecordSENull THEN
BEGIN PopCtx[]; ctxb[seb[rSei].fieldCtx].level ← lZ END;
END;
Resume: PROCEDURE [node: Tree.Index] =
BEGIN OPEN tb[node];
rSei: RecordSEIndex = current.resumeRecord;
n: CARDINAL;
sei: ISEIndex;
IF ~current.resumeFlag THEN Log.Error[misplacedResume];
IF rSei = SENull OR son[1] # Tree.Null
THEN BEGIN son[1] ← MatchFields[rSei, son[1], FALSE]; RPop[] END
ELSE
BEGIN n ← 0;
BumpArgRefs[rSei, FALSE];
FOR sei ← ctxb[seb[rSei].fieldCtx].seList, NextSe[sei] UNTIL sei = SENull
DO
n ← n+1;
IF n=1 AND seb[sei].hash = HTNull THEN Log.Error[illDefinedReturn];
PushSe[sei];
ENDLOOP;
son[1] ← MakeList[n];
END;
current.reachable ← FALSE;
END;
END.