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, CopyTree, 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, ListLength, MakeList, MakeNode, NthSon, PopTree, PushList, 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;
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: BOOL ← FALSE;
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]
};
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]]]};