-- file Pass4Xa.mesa -- last written by Satterthwaite, May 21, 1982 1:54 pm DIRECTORY Alloc: TYPE USING [Notifier], ComData: TYPE USING [ownSymbols, switches, typeINT, typeCARDINAL, typeCHAR, zone], Environment: TYPE USING [bitsPerByte, bitsPerWord, maxCARDINAL, maxINTEGER], Heap: TYPE USING [FreeNode, MakeNode], Inline: TYPE USING [BITAND, BITOR, BITSHIFT], Literals: TYPE USING [Base, LitDescriptor, ltType], LiteralOps: TYPE USING [ValueDescriptor, FindDescriptor, MasterString], Log: TYPE USING [Error, ErrorN, ErrorTree], P4: TYPE USING [ Covering, Repr, none, signed, unsigned, both, other, RegCount, MaxRegs, checked, AdjustBias, BiasForType, BitsForType, CatchNest, ComputeIndexRegs, Exp, ForceType, MakeStructuredLiteral, MakeTreeLiteral, OperandType, RegsForType, RepForType, RValue, StructuredLiteral, TreeLiteral, TreeLiteralDesc, TreeLiteralValue, TypeExp, TypeForTree, VBias, VPop, VPush, VRegs, VRep, WordsForType, ZeroP], Pass4: TYPE USING [implicitBias, implicitRep, implicitType], Symbols: TYPE USING [ Base, BitAddress, SEIndex, ISEIndex, CSEIndex, ArraySEIndex, RecordSEIndex, ISENull, RecordSENull, typeANY, ctxType, seType], SymbolOps: TYPE USING [ ArgRecord, BitsPerElement, Cardinality, FirstVisibleSe, FnField, NextSe, RecordRoot, UnderType, VariantField], Tree: TYPE USING [Base, Index, Link, Map, Scan, Null, treeType], TreeOps: TYPE USING [ FreeNode, FreeTree, GetNode, ListLength, NthSon, OpName, PopTree, PushTree, PushLit, PushNode, ScanList, SetAttr, SetInfo, UpdateList], Types: TYPE USING [Assignable]; Pass4Xa: PROGRAM IMPORTS Heap, Inline, Log, LiteralOps, P4, SymbolOps, TreeOps, Types, dataPtr: ComData, passPtr: Pass4 EXPORTS P4 = { OPEN SymbolOps, TreeOps, P4; -- pervasive definitions from Symbols SEIndex: TYPE = Symbols.SEIndex; ISEIndex: TYPE = Symbols.ISEIndex; CSEIndex: TYPE = Symbols.CSEIndex; RecordSEIndex: TYPE = Symbols.RecordSEIndex; BitAddress: TYPE = Symbols.BitAddress; tb: Tree.Base; -- tree base address (local copy) ltb: Literals.Base; -- literal base address (local copy) seb: Symbols.Base; -- se table base address (local copy) ctxb: Symbols.Base; -- context table base address (local copy) ExpANotify: PUBLIC Alloc.Notifier = { -- called by allocator whenever table area is repacked tb ← base[Tree.treeType]; ltb ← base[Literals.ltType]; seb ← base[Symbols.seType]; ctxb ← base[Symbols.ctxType]}; -- expression list manipulation MakeRecord: PROC [record: RecordSEIndex, expList: Tree.Link] RETURNS [val: Tree.Link, nRegs: RegCount] = { sei: ISEIndex; const: BOOLEAN; subNode: Tree.Index; EvaluateField: Tree.Map = { type: CSEIndex = UnderType[seb[sei].idType]; IF t = Tree.Null THEN { v ← Tree.Null; IF BitsForType[type] # 0 OR VariantType[type] THEN const ← FALSE} ELSE { v ← WITH t SELECT FROM subtree => SELECT tb[index].name FROM construct => NestedConstruct[index, type], union => Union[index, TRUE], ENDCASE => Rhs[t, type], ENDCASE => Rhs[t, type]; IF ~TreeLiteral[v] THEN WITH v SELECT FROM subtree => SELECT tb[index].name FROM mwconst => NULL; union => IF ~tb[index].attr1 THEN const ← FALSE; ENDCASE => const ← FALSE; ENDCASE => const ← FALSE; nRegs ← MAX[VRegs[], nRegs]; VPop[]}; sei ← NextSe[sei]; RETURN}; sei ← FirstVisibleSe[seb[record].fieldCtx]; const ← TRUE; nRegs ← 0; val ← UpdateList[expList, EvaluateField]; IF OpName[val] = list THEN {subNode ← GetNode[val]; tb[subNode].attr1 ← const}; RETURN}; VariantType: PROC [type: CSEIndex] RETURNS [BOOLEAN] = INLINE { RETURN [SELECT seb[type].typeTag FROM union, sequence => TRUE, ENDCASE => FALSE]}; NestedConstruct: PROC [node: Tree.Index, lType: CSEIndex] RETURNS [val: Tree.Link] = { rType: CSEIndex = tb[node].info; val ← Construct[node, TRUE]; IF WordsForType[lType] > WordsForType[rType] THEN val ← PadRecord[val, lType]; RETURN}; MakeArgRecord: PUBLIC PROC [record: RecordSEIndex, expList: Tree.Link] RETURNS [val: Tree.Link] = { SELECT TRUE FROM (expList = Tree.Null) => val ← Tree.Null; (record = Symbols.RecordSENull) => val ← FreeTree[expList]; (OpName[expList] = list) => val ← MakeRecord[record, expList].val; ENDCASE => { type: CSEIndex = UnderType[seb[FirstVisibleSe[seb[record].fieldCtx]].idType]; val ← Rhs[expList, type]; VPop[]}; RETURN}; -- construction of packed values (machine dependent) WordLength: CARDINAL = Environment.bitsPerWord; ByteLength: CARDINAL = Environment.bitsPerByte; FillMultiWord: PUBLIC PROC [ words: LiteralOps.ValueDescriptor, origin: CARDINAL, t: Tree.Link] = { desc: Literals.LitDescriptor = TreeLiteralDesc[t]; IF origin + desc.length <= LENGTH[words] THEN FOR i: CARDINAL IN [0 .. desc.length) DO words[origin+i] ← ltb[desc.offset][i] ENDLOOP}; PackRecord: PROC [record: RecordSEIndex, expList: Tree.Link] RETURNS [Tree.Link] = { n: CARDINAL = WordsForType[record]; root, type: RecordSEIndex; list: Tree.Link; sei: ISEIndex; offset: CARDINAL; words: LiteralOps.ValueDescriptor; more: BOOLEAN; StoreBits: PROC [sei: ISEIndex, value: WORD] = { OPEN Inline; Masks: ARRAY [0..WordLength] OF WORD = [0b, 1b, 3b, 7b, 17b, 37b, 77b, 177b, 377b, 777b, 1777b, 3777b, 7777b, 17777b, 37777b, 77777b, 177777b]; address: BitAddress; size, w, shift: CARDINAL; IF seb[root].argument THEN [address, size] ← FnField[sei] ELSE {address ← seb[sei].idValue; size ← seb[sei].idInfo}; w ← address.wd; shift ← (WordLength-offset) - (address.bd+size); words[w] ← BITOR[words[w], BITSHIFT[BITAND[value, Masks[size]], shift]]}; PackField: Tree.Scan = { node: Tree.Index; address: BitAddress; typeId: ISEIndex; subType: CSEIndex; SELECT TRUE FROM t = Tree.Null => NULL; TreeLiteral[t] => StoreBits[sei, TreeLiteralValue[t]]; ENDCASE => { node ← GetNode[t]; SELECT tb[node].name FROM mwconst => { address ← IF seb[root].argument THEN FnField[sei].offset ELSE seb[sei].idValue; FillMultiWord[words, address.wd, tb[node].son[1]]}; union => { typeId ← WITH tb[node].son[1] SELECT FROM symbol => index, ENDCASE => ERROR; subType ← UnderType[seb[sei].idType]; WITH seb[subType] SELECT FROM union => IF controlled THEN StoreBits[tagSei, seb[typeId].idValue]; ENDCASE => ERROR; type ← LOOPHOLE[UnderType[typeId], RecordSEIndex]; list ← tb[node].son[2]; more ← TRUE}; ENDCASE => ERROR}; sei ← NextSe[sei]}; words ← DESCRIPTOR[Heap.MakeNode[dataPtr.zone, n], n]; FOR i: CARDINAL IN [0 .. n) DO words[i] ← 0 ENDLOOP; root ← type ← RecordRoot[record]; offset ← IF seb[record].length < WordLength THEN WordLength - seb[record].length ELSE 0; list ← expList; more ← TRUE; WHILE more DO more ← FALSE; sei ← FirstVisibleSe[seb[type].fieldCtx]; ScanList[list, PackField]; ENDLOOP; PushLit[LiteralOps.FindDescriptor[words]]; PushNode[IF n=1 THEN cast ELSE mwconst, 1]; SetInfo[record]; Heap.FreeNode[dataPtr.zone, BASE[words]]; RETURN [PopTree[]]}; PadRecord: PUBLIC PROC [t: Tree.Link, lType: CSEIndex] RETURNS [Tree.Link] = { IF StructuredLiteral[t] THEN { nW: CARDINAL = WordsForType[lType]; words: LiteralOps.ValueDescriptor; node: Tree.Index; words ← DESCRIPTOR[Heap.MakeNode[dataPtr.zone, nW], nW]; FOR w: CARDINAL IN [0 .. nW) DO words[w] ← 0 ENDLOOP; IF TreeLiteral[t] THEN words[0] ← TreeLiteralValue[t] ELSE { node ← GetNode[t]; SELECT tb[node].name FROM mwconst => FillMultiWord[words, 0, tb[node].son[1]]; ENDCASE => ERROR; FreeNode[node]}; PushLit[LiteralOps.FindDescriptor[words]]; PushNode[mwconst, 1]; Heap.FreeNode[dataPtr.zone, BASE[words]]} ELSE {PushTree[t]; PushNode[pad, 1]}; SetInfo[lType]; RETURN [PopTree[]]}; ExtractValue: PROC [t: Tree.Link, addr: BitAddress, size: CARDINAL, type: CSEIndex] RETURNS [val: Tree.Link] = { words: LiteralOps.ValueDescriptor; desc: Literals.LitDescriptor = TreeLiteralDesc[t]; n: CARDINAL = size/WordLength; IF n > 1 THEN { IF addr.bd # 0 THEN Log.Error[unimplemented]; words ← DESCRIPTOR[Heap.MakeNode[dataPtr.zone, n], n]; FOR i: CARDINAL IN [0..n) DO words[i] ← ltb[desc.offset][addr.wd+i] ENDLOOP; PushLit[LiteralOps.FindDescriptor[words]]; PushNode[mwconst, 1]; SetInfo[type]; Heap.FreeNode[dataPtr.zone, BASE[words]]; val ← PopTree[]} ELSE val ← MakeStructuredLiteral[ Inline.BITSHIFT[ Inline.BITSHIFT[ltb[desc.offset][addr.wd], addr.bd], -(WordLength - size)], type]; RETURN}; UnpackField: PROC [t: Tree.Link, field: ISEIndex] RETURNS [val: Tree.Link] = { rType: CSEIndex = OperandType[t]; vType: CSEIndex = UnderType[seb[field].idType]; addr: BitAddress; addr ← seb[field].idValue; WITH r: seb[rType] SELECT FROM record => IF r.length < WordLength THEN addr.bd ← addr.bd + (WordLength - r.length); ENDCASE => ERROR; RETURN [ExtractValue[t, addr, seb[field].idInfo, vType]]}; UnpackElement: PROC [t: Tree.Link, i: CARDINAL] RETURNS [val: Tree.Link] = { aType: CSEIndex = OperandType[t]; cType: CSEIndex; addr: BitAddress; nB, nW: CARDINAL; WITH a: seb[aType] SELECT FROM array => { cType ← UnderType[a.componentType]; nB ← BitsPerElement[cType, a.packed]; IF nB > ByteLength THEN { nW ← (nB+(WordLength-1))/WordLength; addr ← [wd:i*nW, bd:0]; nB ← nW*WordLength} ELSE { itemsPerWord: CARDINAL = WordLength/nB; offset: CARDINAL = IF WordsForType[aType] = 1 THEN WordLength - BitsForType[aType] ELSE 0; addr ← [wd: i/itemsPerWord, bd: offset + (i MOD itemsPerWord)*nB]}}; ENDCASE => ERROR; RETURN [ExtractValue[t, addr, nB, cType]]}; -- operators Call: PUBLIC PROC [node: Tree.Index] RETURNS [Tree.Link] = { OPEN tb[node]; type: CSEIndex; son[1] ← Exp[son[1], none]; VPop[]; type ← OperandType[son[1]]; WITH t: seb[type] SELECT FROM transfer => { IF attr1 AND name # xerror AND t.typeIn # Symbols.RecordSENull THEN { son[2] ← Rhs[son[2], t.typeIn]; VPop[]} ELSE son[2] ← MakeArgRecord[ArgRecord[t.typeIn], son[2]]; VPush[BiasForType[t.typeOut], RepForType[t.typeOut], MaxRegs]}; ENDCASE => ERROR; IF nSons > 2 THEN CatchNest[son[3]]; RETURN [[subtree[index: node]]]}; Construct: PUBLIC PROC [node: Tree.Index, nested: BOOLEAN] RETURNS [val: Tree.Link] = { OPEN tb[node]; type: RecordSEIndex = info; record: RecordSEIndex = RecordRoot[type]; nRegs: RegCount; k: RegCount = RegsForType[type]; [son[2], nRegs] ← MakeRecord[record, son[2]]; SELECT TRUE FROM (OpName[son[2]] = list OR OpName[son[2]] = union) => { subNode: Tree.Index = GetNode[son[2]]; IF ~tb[subNode].attr1 THEN { -- ~all fields constant val ← [subtree[index: node]]; nRegs ← MAX[nRegs, k]} ELSE {val ← PackRecord[type, son[2]]; FreeNode[node]; nRegs ← k}; VPush[0, other, nRegs]}; (son[2] = Tree.Null) => {val ← Tree.Null; VPush[0, other, 0]}; ENDCASE => val ← CastUniList[node, type, nested]; RETURN}; Union: PUBLIC PROC [node: Tree.Index, nested: BOOLEAN] RETURNS [val: Tree.Link] = { OPEN tb[node]; vSei: ISEIndex = WITH son[1] SELECT FROM symbol=>index, ENDCASE=>ERROR; type: RecordSEIndex = LOOPHOLE[UnderType[vSei]]; tSei: CSEIndex = UnderType[info]; tagged: BOOLEAN = WITH seb[tSei] SELECT FROM union => controlled, ENDCASE => FALSE; nRegs: RegCount; [son[2], nRegs] ← MakeRecord[type, son[2]]; attr2 ← tagged; SELECT TRUE FROM (OpName[son[2]] = list OR OpName[son[2]] = union) => { attr1 ← WITH son[2] SELECT FROM subtree => tb[index].attr1, ENDCASE => FALSE; val ← [subtree[index: node]]; VPush[0, other, nRegs]}; (son[2] = Tree.Null) => { attr1 ← TRUE; val ← [subtree[index: node]]; VPush[0, other, 1]}; ENDCASE => IF (~tagged OR seb[vSei].idValue = 0) AND WordsForType[type] = 1 AND ZeroOffset[IF tagged THEN TagSei[tSei] ELSE FirstVisibleSe[seb[type].fieldCtx]] THEN val ← CastUniList[node, type, nested] ELSE { attr1 ← StructuredLiteral[son[2]]; val ← [subtree[index: node]]; VPush[0, other, RegsForType[type]]}; RETURN}; TagSei: PROC [tSei: CSEIndex] RETURNS [ISEIndex] = INLINE { RETURN [WITH seb[tSei] SELECT FROM union => tagSei, ENDCASE => Symbols.ISENull]}; ZeroOffset: PROC [sei: ISEIndex] RETURNS [BOOLEAN] = INLINE { RETURN [sei # Symbols.ISENull AND seb[sei].idValue = BitAddress[0, 0]]}; CastUniList: PROC [node: Tree.Index, type: CSEIndex, nested: BOOLEAN] RETURNS [val: Tree.Link] = { subNode: Tree.Index; unSafe: BOOLEAN; t: Tree.Link ← tb[node].son[2]; IF (unSafe ← OpName[t] = safen) THEN { subNode ← GetNode[t]; t ← tb[subNode].son[1]; tb[subNode].son[1] ← Tree.Null; FreeNode[subNode]}; tb[node].son[2] ← Tree.Null; FreeNode[node]; val ← ForceType[t, type]; IF unSafe AND nested THEN { PushTree[val]; PushNode[safen, 1]; SetInfo[type]; val ← PopTree[]}; VPush[BiasForType[type], RepForType[type], RegsForType[type]]; RETURN}; RowConstruct: PUBLIC PROC [node: Tree.Index] RETURNS [val: Tree.Link] = { OPEN tb[node]; aType: Symbols.ArraySEIndex = info; cType: CSEIndex = UnderType[seb[aType].componentType]; n: CARDINAL = Cardinality[seb[aType].indexType]; const, strings, lstrings: BOOLEAN; nRegs: RegCount; l: CARDINAL; EvalElement: Tree.Map = { IF t = Tree.Null THEN {v ← Tree.Null; const ← strings ← lstrings ← FALSE} ELSE { v ← Rhs[t, cType]; nRegs ← MAX[VRegs[], nRegs]; IF TreeLiteral[v] THEN strings ← lstrings ← FALSE ELSE WITH v SELECT FROM subtree => SELECT tb[index].name FROM mwconst => strings ← lstrings ← FALSE; ENDCASE => const ← strings ← lstrings ← FALSE; literal => WITH info SELECT FROM string => { const ← FALSE; IF LiteralOps.MasterString[index] = index THEN lstrings ← FALSE ELSE strings ← FALSE}; ENDCASE; ENDCASE => const ← strings ← lstrings ← FALSE; VPop[]}; RETURN}; w, nW: CARDINAL; words: LiteralOps.ValueDescriptor; bitsLeft: CARDINAL; bitCount: CARDINAL; PackElement: Tree.Scan = { IF TreeLiteral[t] THEN { bitsLeft ← bitsLeft - bitCount; words[w] ← Inline.BITOR[words[w], Inline.BITSHIFT[TreeLiteralValue[t], bitsLeft]]; IF bitsLeft < bitCount THEN {w ← w+1; bitsLeft ← WordLength}} ELSE { node: Tree.Index = GetNode[t]; SELECT tb[node].name FROM mwconst => { FillMultiWord[words, w, tb[node].son[1]]; w ← w + WordsForType[cType]}; ENDCASE => ERROR}}; SELECT (l ← ListLength[son[2]]) FROM = n => NULL; > n => Log.ErrorN[listLong, l-n]; < n => Log.ErrorN[listShort, n-l]; ENDCASE; const ← strings ← lstrings ← TRUE; nRegs ← 0; son[2] ← UpdateList[son[2], EvalElement]; IF const AND l = n THEN { nW ← WordsForType[aType]; words ← DESCRIPTOR[Heap.MakeNode[dataPtr.zone, nW], nW]; FOR w: CARDINAL IN [0 .. nW) DO words[w] ← 0 ENDLOOP; bitCount ← BitsPerElement[cType, seb[aType].packed]; w ← 0; bitsLeft ← IF nW = 1 THEN BitsForType[aType] ELSE WordLength; ScanList[son[2], PackElement]; FreeNode[node]; PushLit[LiteralOps.FindDescriptor[words]]; PushNode[IF nW = 1 THEN cast ELSE mwconst, 1]; SetInfo[aType]; Heap.FreeNode[dataPtr.zone, BASE[words]]; val ← PopTree[]; nRegs ← RegsForType[aType]} ELSE {attr1 ← strings # lstrings; val ← [subtree[index: node]]}; VPush[0, other, nRegs]; RETURN}; All: PUBLIC PROC [node: Tree.Index] RETURNS [val: Tree.Link] = { OPEN tb[node]; aType: Symbols.ArraySEIndex = info; cType: CSEIndex = UnderType[seb[aType].componentType]; val ← [subtree[index: node]]; IF son[1] # Tree.Null THEN { son[1] ← Rhs[son[1], cType]; IF TreeLiteral[son[1]] AND WordsForType[aType] = 1 THEN { nB: CARDINAL = BitsPerElement[cType, seb[aType].packed]; v, w: WORD; v ← TreeLiteralValue[son[1]]; w ← 0; THROUGH [1 .. Cardinality[seb[aType].indexType]] DO w ← Inline.BITOR[Inline.BITSHIFT[w, nB], v] ENDLOOP; val ← ForceType[MakeTreeLiteral[w], aType]; FreeNode[node]} ELSE IF OperandType[son[1]] # cType THEN son[1] ← ForceType[son[1], cType]; VPop[]}; VPush[0, other, RegsForType[aType]]; RETURN}; Dollar: PUBLIC PROC [node: Tree.Index] RETURNS [val: Tree.Link] = { OPEN tb[node]; rep: Repr; bias: INTEGER; nRegs: RegCount; k: RegCount = RegsForType[info]; son[1] ← RValue[son[1], BiasForType[OperandType[son[1]]], none]; nRegs ← VRegs[]; VPop[]; son[2] ← Exp[son[2], none]; rep ← VRep[]; bias ← VBias[]; VPop[]; IF ~StructuredLiteral[son[1]] THEN {val ← [subtree[index: node]]; nRegs ← MAX[nRegs, k]} ELSE WITH son[2] SELECT FROM symbol => {val ← UnpackField[son[1], index]; FreeNode[node]; nRegs ← k}; ENDCASE => ERROR; VPush[bias, rep, nRegs]; RETURN}; Index: PUBLIC PROC [node: Tree.Index] RETURNS [val: Tree.Link] = { OPEN tb[node]; iType, cType: CSEIndex; next: SEIndex; nRegs: RegCount; son[1] ← Exp[son[1], none]; FOR aType: CSEIndex ← OperandType[son[1]], UnderType[next] DO WITH seb[aType] SELECT FROM array => { iType ← UnderType[indexType]; cType ← UnderType[componentType]; EXIT}; arraydesc => next ← describedType; long => next ← rangeType; ENDCASE => ERROR; ENDLOOP; IF name = dindex THEN { son[2] ← RValue[son[2], BiasForType[iType], unsigned]; attr1 ← checked OR dataPtr.switches['n]; attr3 ← checked OR dataPtr.switches['b]} ELSE son[2] ← Rhs[son[2], iType, TRUE]; SELECT TRUE FROM (TreeLiteral[son[2]] AND OpName[son[1]] = all) => { subNode: Tree.Index = GetNode[son[1]]; val ← tb[subNode].son[1]; tb[subNode].son[1] ← Tree.Null; FreeNode[node]; nRegs ← RegsForType[cType]}; (TreeLiteral[son[2]] AND StructuredLiteral[son[1]]) => { val ← UnpackElement[son[1], TreeLiteralValue[son[2]]]; FreeNode[node]; nRegs ← RegsForType[cType]}; ENDCASE => { val ← [subtree[index:node]]; nRegs ← ComputeIndexRegs[node]}; VPop[]; VPop[]; VPush[BiasForType[cType], RepForType[cType], nRegs]; RETURN}; SeqIndex: PUBLIC PROC [node: Tree.Index] RETURNS [Tree.Link] = { OPEN tb[node]; iType, cType, sType: CSEIndex; nRegs: RegCount; son[1] ← Exp[son[1], none]; sType ← OperandType[son[1]]; WITH t: seb[sType] SELECT FROM sequence => { iType ← UnderType[seb[t.tagSei].idType]; cType ← UnderType[t.componentType]; attr3 ← t.controlled AND (checked OR dataPtr.switches['b])}; array => { iType ← UnderType[t.indexType]; cType ← UnderType[t.componentType]; attr3 ← checked OR dataPtr.switches['b]}; ENDCASE; son[2] ← RValue[son[2], BiasForType[iType], TargetRep[RepForType[iType]]]; nRegs ← ComputeIndexRegs[node]; VPop[]; VPop[]; VPush[BiasForType[cType], RepForType[cType], nRegs]; RETURN [[subtree[index:node]]]}; Reloc: PUBLIC PROC [node: Tree.Index] RETURNS [val: Tree.Link] = { nRegs: RegCount; type: CSEIndex = tb[node].info; tb[node].son[1] ← RValue[tb[node].son[1], 0, unsigned]; tb[node].son[2] ← RValue[tb[node].son[2], 0, unsigned]; nRegs ← ComputeIndexRegs[node]; VPop[]; VPop[]; IF ~tb[node].attr1 AND ZeroP[tb[node].son[1]] THEN { rType, subType, next: CSEIndex; FOR subType ← OperandType[tb[node].son[2]], next DO -- CanonicalType WITH r: seb[subType] SELECT FROM relative => { rType ← UnderType[r.resultType]; PushTree[tb[node].son[2]]; tb[node].son[2] ← Tree.Null; IF tb[node].attr2 AND seb[UnderType[r.offsetType]].typeTag # long THEN { PushNode[lengthen, 1]; SetAttr[1, FALSE]; SetAttr[2, FALSE]; SetAttr[3, FALSE]} ELSE PushNode[cast, 1]; EXIT}; record => next ← UnderType[seb[FirstVisibleSe[r.fieldCtx]].idType]; ENDCASE => ERROR; ENDLOOP; SetInfo[rType]; PushNode[uparrow, 1]; SetInfo[type]; SetAttr[1, dataPtr.switches['n]]; SetAttr[2, tb[node].attr2]; val ← PopTree[]; FreeNode[node]} ELSE val ← [subtree[node]]; VPush[BiasForType[type], RepForType[type], nRegs]}; Assignment: PUBLIC PROC [node: Tree.Index] RETURNS [Tree.Link] = { OPEN tb[node]; lhsType: CSEIndex; son[1] ← Exp[son[1], none]; lhsType ← OperandType[son[1]]; son[2] ← Rhs[son[2], lhsType]; VPop[]; RETURN [RewriteAssign[node, lhsType]]}; Extract: PUBLIC PROC [node: Tree.Index] RETURNS [Tree.Link] = { subNode: Tree.Index = GetNode[tb[node].son[1]]; rType: RecordSEIndex = tb[subNode].info; sei: ISEIndex; AssignItem: Tree.Map = { type: CSEIndex; saveType: CSEIndex = passPtr.implicitType; saveBias: INTEGER = passPtr.implicitBias; saveRep: Repr = passPtr.implicitRep; IF t = Tree.Null THEN v ← Tree.Null ELSE { subNode: Tree.Index = GetNode[t]; type ← UnderType[seb[sei].idType]; passPtr.implicitType ← type; passPtr.implicitBias ← BiasForType[type]; passPtr.implicitRep ← RepForType[type]; v ← IF tb[subNode].name = extract THEN Extract[subNode] ELSE Assignment[subNode]; VPop[]}; sei ← NextSe[sei]; passPtr.implicitRep ← saveRep; passPtr.implicitBias ← saveBias; passPtr.implicitType ← saveType; RETURN}; sei ← FirstVisibleSe[seb[rType].fieldCtx]; tb[subNode].son[1] ← UpdateList[tb[subNode].son[1], AssignItem]; tb[node].son[2] ← Exp[tb[node].son[2], none]; VPop[]; VPush[BiasForType[rType], RepForType[rType], MaxRegs]; RETURN [[subtree[index:node]]]}; New: PUBLIC PROC [node: Tree.Index] RETURNS [Tree.Link] = { OPEN tb[node]; IF son[1] # Tree.Null THEN {son[1] ← Exp[son[1], none]; VPop[]}; IF OpName[son[2]] = apply THEN { subNode: Tree.Index = GetNode[son[2]]; vSei: ISEIndex; TypeExp[tb[subNode].son[1]]; tb[subNode].son[2] ← Rhs[tb[subNode].son[2], dataPtr.typeCARDINAL]; VPop[]; vSei ← VariantField[UnderType[TypeForTree[tb[subNode].son[1]]]]; IF vSei # Symbols.ISENull THEN { vType: CSEIndex = UnderType[seb[vSei].idType]; n: CARDINAL = WITH t: seb[vType] SELECT FROM sequence => Cardinality[seb[t.tagSei].idType], ENDCASE => 0; subType: CSEIndex = OperandType[tb[subNode].son[2]]; IF subType = dataPtr.typeINT OR ~(Cardinality[subType] IN [1..n]) THEN -- (0..n] tb[subNode].son[2] ← CheckRange[tb[subNode].son[2], n, dataPtr.typeCARDINAL]}} ELSE TypeExp[son[2], OpName[son[3]] = body]; SELECT OpName[son[3]] FROM body => { expNode: Tree.Index = GetNode[son[3]]; PushNode[body, 0]; SetInfo[tb[expNode].info]; son[3] ← PopTree[]}; signalinit => NULL; ENDCASE => IF son[3] # Tree.Null THEN { son[3] ← Rhs[son[3], UnderType[TypeForTree[son[2]]]]; VPop[]}; IF nSons > 3 THEN CatchNest[son[4]]; VPush[0, unsigned, MaxRegs]; RETURN [[subtree[index:node]]]}; Narrow: PUBLIC PROC [node: Tree.Index] RETURNS [val: Tree.Link] = { type: CSEIndex = tb[node].info; IF tb[node].son[2] # Tree.Null THEN TypeExp[tb[node].son[2]]; IF tb[node].attr2 OR tb[node].attr3 THEN { OPEN tb[node]; son[1] ← RValue[son[1], 0, RepForType[OperandType[son[1]]]]; VPop[]; IF nSons > 2 THEN CatchNest[son[3]]; val ← [subtree[index: node]]; VPush[BiasForType[type], RepForType[type], MaxRegs]} ELSE { val ← Rhs[tb[node].son[1], type]; tb[node].son[1] ← Tree.Null; FreeNode[node]}}; TargetRep: --PUBLIC-- PROC [rep: Repr] RETURNS [Repr] = INLINE { RETURN [--IF rep = both THEN signed ELSE-- rep]}; Rhs: PUBLIC PROC [exp: Tree.Link, lType: CSEIndex, voidOK: BOOLEAN ← FALSE] RETURNS [val: Tree.Link] = { lBias: INTEGER = BiasForType[lType]; lRep: Repr = RepForType[lType]; nw: CARDINAL = WordsForType[lType]; rType: CSEIndex = OperandType[exp]; rRep: Repr; val ← RValue[exp, lBias, TargetRep[lRep]]; rRep ← VRep[]; IF ~Types.Assignable[[dataPtr.ownSymbols, lType], [dataPtr.ownSymbols, rType]] THEN Log.ErrorTree[typeClash, val]; IF ~(IF nw = 0 THEN voidOK ELSE WordsForType[rType] = nw) THEN SELECT TRUE FROM (seb[lType].typeTag = record) AND (seb[rType].typeTag = record) => val ← PadRecord[val, lType]; (seb[lType].typeTag = union) AND (seb[rType].typeTag = union) => NULL; ENDCASE => Log.ErrorTree[sizeClash, val]; IF (lType = dataPtr.typeINT AND rRep = unsigned) OR ((rType = dataPtr.typeINT AND rRep = signed) AND lRep = unsigned) THEN val ← CheckRange[val, CARDINAL[Environment.maxINTEGER-lBias]+1, lType] ELSE SELECT seb[lType].typeTag FROM subrange, enumerated, relative => SELECT Cover[lType, lRep, rType, rRep] FROM full => NULL; partial => val ← CheckRange[val, Cardinality[lType], lType]; ENDCASE => IF nw # 0 THEN val ← BoundsFault[val, lType]; basic => IF lType = dataPtr.typeCHAR AND (rRep # both OR TreeLiteral[val]) THEN val ← CheckRange[val, Cardinality[lType], lType]; ENDCASE => NULL; RETURN}; Cover: PUBLIC PROC [lType: CSEIndex, lRep: Repr, rType: CSEIndex, rRep: Repr] RETURNS [Covering] = { lLb, lUb, rLb, rUb: LONG INTEGER; [lLb, lUb] ← Bounds[lType, lRep]; [rLb, rUb] ← Bounds[rType, rRep]; RETURN [ IF lLb <= rLb THEN IF lUb < rLb THEN none ELSE IF lUb < rUb THEN partial ELSE full ELSE IF lLb <= rUb THEN partial ELSE none]}; Bounds: PROC [type: CSEIndex, rep: Repr] RETURNS [lb, ub: LONG INTEGER] = { WITH t: seb[type] SELECT FROM subrange => {lb ← t.origin; ub ← lb + t.range}; enumerated => {lb ← 0; ub ← t.nValues-1}; relative => [lb, ub] ← Bounds[UnderType[t.offsetType], rep]; ENDCASE => SELECT rep FROM signed => {lb ← -Environment.maxINTEGER-1; ub ← Environment.maxINTEGER}; both => {lb ← 0; ub ← Environment.maxINTEGER}; ENDCASE => {lb ← 0; ub ← Environment.maxCARDINAL}; RETURN}; CheckRange: PUBLIC PROC [t: Tree.Link, bound: CARDINAL, type: CSEIndex] RETURNS [val: Tree.Link] = { SELECT TRUE FROM (bound = 0) => val ← t; TreeLiteral[t] => val ← IF TreeLiteralValue[t] >= bound THEN BoundsFault[t,type] ELSE t; (checked OR dataPtr.switches['b]) AND ~Bounded[t, bound] => { PushTree[MakeTreeLiteral[bound]]; IF OpName[t] = safen THEN { node: Tree.Index = GetNode[t]; PushTree[tb[node].son[1]]; PushNode[check, -2]; SetInfo[type]; tb[node].son[1] ← PopTree[]; val ← t} ELSE {PushTree[t]; PushNode[check,-2]; SetInfo[type]; val ← PopTree[]}}; ENDCASE => val ← t; RETURN}; Bounded: PROC [t: Tree.Link, bound: CARDINAL] RETURNS [BOOLEAN] = INLINE { IF OpName[t] = mod THEN { t2: Tree.Link = NthSon[t, 2]; RETURN [TreeLiteral[t2] AND TreeLiteralValue[t2] IN [0..bound]]} ELSE RETURN [FALSE]}; BoundsFault: PROC [t: Tree.Link, type: CSEIndex] RETURNS [Tree.Link] = { Log.ErrorTree[boundsFault, AdjustBias[t, -BiasForType[type]]]; PushTree[t]; -- PushTree[MakeTreeLiteral[0]]; PushNode[check, 2]; SetInfo[type]; RETURN [PopTree[]]}; RewriteAssign: PUBLIC PROC [node: Tree.Index, lType: CSEIndex] RETURNS [Tree.Link] = { IF seb[lType].typeTag = union THEN { WITH tb[node].son[1] SELECT FROM subtree => { subType: CSEIndex; subNode: Tree.Index = index; SELECT tb[subNode].name FROM dot => { subType ← OperandType[tb[subNode].son[1]]; PushTree[tb[subNode].son[1]]; PushNode[uparrow, 1]; SetInfo[WITH seb[subType] SELECT FROM ref => UnderType[refType], ENDCASE => Symbols.typeANY]; tb[subNode].son[1] ← PopTree[]; tb[subNode].name ← dollar}; dollar => NULL; ENDCASE => NULL}; -- flagged by code generators for now ENDCASE => NULL}; -- flagged by code generators for now IF tb[node].name = assignx THEN tb[node].info ← OperandType[tb[node].son[1]]; RETURN [[subtree[index: node]]]}; }.