<> <> <> <> <> DIRECTORY Alloc: TYPE USING [Notifier], BcdDefs: TYPE USING [EPLimit, IRLinkLimit], ComData: TYPE USING [idANY, importCtx, interface, linkCount, nBodies, nSigCodes, switches, textIndex], CompilerUtil: TYPE USING [AppendBCDWord], Log: TYPE USING [Error, ErrorN, ErrorSei, WarningSei], P4: TYPE USING [], PrincOps: TYPE USING [ ControlLink, EPRange, globalbase, localbase, MaxFrameSize, MaxNGfi, Port, PsbIndex], SourceMap: TYPE USING [Loc], Symbols: TYPE USING [Base, BitAddress, BitCount, FieldBitCount, PackedBitCount, WordCount, Type, ISEIndex, CSEIndex, RecordSEIndex, CTXIndex, BTIndex, CBTIndex, nullName, ISENull, RecordSENull, CTXNull, BTNull, lL, RootBti, WordLength, bodyType, ctxType, seType], SymbolOps: TYPE USING [ArgCtx, ArgRecord, BitsForRange, Cardinality, FirstCtxSe, LinkMode, MakeCtxSe, NextSe, PackedSize, TypeForm, UnderType, XferMode], Tree: TYPE USING [Base, Index, Link, Scan, NullIndex, treeType], TreeOps: TYPE USING [ScanList]; Pass4L: PROGRAM IMPORTS CompilerUtil, Log, SymbolOps, TreeOps, dataPtr: ComData EXPORTS P4 = { OPEN SymbolOps, Symbols; tb: Tree.Base; -- tree base (local copy) seb: Symbols.Base; -- se table base (local copy) ctxb: Symbols.Base; -- context table base (local copy) bb: Symbols.Base; -- body table base (local copy) LayoutNotify: PUBLIC Alloc.Notifier = { <> tb _ base[Tree.treeType]; seb _ base[seType]; ctxb _ base[ctxType]; bb _ base[bodyType]}; <
> wordFill: CARDINAL = WordLength-1; localOrigin: CARDINAL = PrincOps.localbase*WordLength; localSlots: CARDINAL = 8; globalOrigin: CARDINAL = PrincOps.globalbase*WordLength; frameLimit: CARDINAL = PrincOps.MaxFrameSize*WordLength; entryLimit: CARDINAL = MIN[BcdDefs.EPLimit, PrincOps.MaxNGfi*PrincOps.EPRange]; BitsForType: PUBLIC PROC[type: Type] RETURNS[nBits: BitCount] = { <> sei: CSEIndex = UnderType[type]; WITH seb[sei] SELECT FROM basic => nBits _ length; enumerated => nBits _ BitsForRange[Cardinality[sei]-1]; ref => nBits _ WordLength; transfer => nBits _ WordLength * (SELECT mode FROM proc => PrincOps.ControlLink.SIZE, port => PrincOps.Port.SIZE, signal, error => PrincOps.ControlLink.SIZE, process => PrincOps.PsbIndex.SIZE, program => PrincOps.ControlLink.SIZE, ENDCASE => ERROR); arraydesc => nBits _ 2*WordLength; relative => nBits _ BitsForType[offsetType]; zone => nBits _ (IF mds THEN 1 ELSE 2)*WordLength; long => nBits _ ((BitsForType[rangeType] + wordFill)/WordLength + 1)*WordLength; real => nBits _ 2*WordLength; ENDCASE => { -- processing of se entry must be complete IF ~mark4 THEN { -- P4declitem has not been able to complete Log.ErrorSei[typeLength, IF seb[type].seTag = id THEN LOOPHOLE[type, ISEIndex] ELSE ISENull]; RETURN[0]}; WITH seb[sei] SELECT FROM record => nBits _ length; array => { n: LONG CARDINAL = Cardinality[indexType]; b: BitCount _ BitsForType[componentType]; IF packed AND (b#0 AND b<=PackedBitCount.LAST) THEN { -- b IN PackedBitCount itemsPerWord: CARDINAL = WordLength/PackedSize[b]; nBits _ IF n <= itemsPerWord THEN n*PackedSize[b] ELSE ((n+(itemsPerWord-1))/itemsPerWord)*WordLength} ELSE { b _ ((b + wordFill)/WordLength)*WordLength; IF n > CARDINAL.LAST/b THEN Log.Error[arraySize]; nBits _ n*b}}; opaque => nBits _ length; subrange => nBits _ IF empty THEN 0 ELSE BitsForRange[Cardinality[sei]-1]; ENDCASE => nBits _ 0}; RETURN}; <> VarLink: TYPE = RECORD [ SELECT kind: * FROM symbol => [index: ISEIndex], body => [index: CBTIndex], empty => [], ENDCASE]; VarInfo: TYPE = RECORD [link: VarLink, key: CARDINAL]; VarInfoList: TYPE = RECORD [SEQUENCE length: NAT OF VarInfo]; Profile: TYPE = REF VarInfoList; AllocateProfile: PROC[n: CARDINAL] RETURNS[profile: Profile] = { profile _ NEW[VarInfoList[n]]; FOR k: CARDINAL IN [0 .. n) DO profile[k].link _ [empty[]] ENDLOOP; RETURN}; SortProfile: PROC[v: Profile] = { -- Shell sort -- i, j: INTEGER; k: CARDINAL; t: VarInfo; h: NAT _ v.length; DO h _ h/2; FOR j IN [h .. v.length) DO i _ j-h; k _ v[j].key; t _ v[j]; WHILE k > v[i].key DO v[i+h] _ v[i]; IF (i _ i-h) < 0 THEN EXIT; ENDLOOP; v[i+h] _ t; ENDLOOP; IF h <= 1 THEN EXIT; ENDLOOP}; MergeProfiles: PROC[profile1, profile2: Profile] RETURNS[profile: Profile] = { i, i1, i2: CARDINAL _ 0; profile _ NEW[VarInfoList[profile1.length+profile2.length]]; WHILE i1 < profile1.length AND i2 < profile2.length DO IF profile1[i1].key > profile2[i2].key THEN {profile[i] _ profile1[i1]; i1 _ i1+1} ELSE {profile[i] _ profile2[i2]; i2 _ i2+1}; i _ i + 1 ENDLOOP; WHILE i1 < profile1.length DO profile[i] _ profile1[i1]; i1 _ i1+1; i _ i + 1 ENDLOOP; WHILE i2 < profile2.length DO profile[i] _ profile2[i2]; i2 _ i2+1; i _ i + 1 ENDLOOP; }; <> GenBodies: PROC[root: BTIndex, proc: PROC[CBTIndex]] = { bti, next: BTIndex; FOR bti _ root, next UNTIL bti = BTNull DO WITH bb[bti] SELECT FROM Callable => proc[LOOPHOLE[bti]]; ENDCASE => NULL; IF bb[bti].firstSon # BTNull THEN next _ bb[bti].firstSon ELSE DO next _ bb[bti].link.index; IF next = BTNull OR bb[bti].link.which # parent THEN EXIT; bti _ next; ENDLOOP; ENDLOOP}; BodyRefs: PROC[bti: CBTIndex] RETURNS[count: CARDINAL_0] = { sei: ISEIndex = bb[bti].id; CountRefs: Tree.Scan = { count _ count + seb[NARROW[t, Tree.Link.symbol].index].idInfo}; IF sei # ISENull THEN { node: Tree.Index = seb[sei].idValue; TreeOps.ScanList[tb[node].son[1], CountRefs]}; RETURN}; AssignEntries: PUBLIC PROC[rootBti: BTIndex] = { i, k: INTEGER; profile: Profile; bti: CBTIndex; AssignSlot: PROC[bti: CBTIndex] = { IF ~bb[bti].inline AND bb[bti].info.mark = Internal THEN { n: CARDINAL = BodyRefs[bti]; profile[k].link _ [body[index: bti]]; WITH body: bb[bti] SELECT FROM Inner => {body.frameOffset _ n; profile[k].key _ 0}; ENDCASE => profile[k].key _ n; k _ k+1}}; nEntries: CARDINAL = MAX[dataPtr.nBodies, dataPtr.nSigCodes]; IF nEntries > entryLimit THEN Log.ErrorN[bodyEntries, nEntries-entryLimit]; profile _ AllocateProfile[dataPtr.nBodies]; k _ 0; GenBodies[rootBti, AssignSlot]; IF dataPtr.switches['s] THEN SortProfile[profile]; i _ 1; FOR j: INTEGER IN [0..profile.length) DO bti _ NARROW[profile[j].link, VarLink.body].index; IF bti = RootBti THEN bb[bti].entryIndex _ 0 ELSE {bb[bti].entryIndex _ i; i _ i+1}; ENDLOOP; profile _ NIL}; <> FieldWordCount: TYPE = [0..FieldBitCount.LAST/WordLength]; WordsForField: PROC[sei: ISEIndex] RETURNS[nW: FieldWordCount] = { nBits: BitCount = BitsForType[seb[sei].idType] + wordFill; IF nBits > FieldBitCount.LAST THEN { Log.ErrorSei[addressOverflow, sei]; nW _ FieldWordCount.LAST} ELSE nW _ FieldBitCount[nBits]/WordLength; RETURN}; VarScan: TYPE = PROC[sei: ISEIndex, output: BOOL]; GenCtxVars: PROC[ctx: CTXIndex, p: VarScan, output: BOOL] = { FOR sei: ISEIndex _ FirstCtxSe[ctx], NextSe[sei] UNTIL sei = ISENull DO IF ~seb[sei].constant THEN p[sei, output] ENDLOOP}; GenBodyVars: PROC[bti: CBTIndex, p: VarScan] = { type: Type = bb[bti].ioType; WITH se: seb[type] SELECT FROM cons => WITH t: se SELECT FROM transfer => { GenCtxVars[ArgCtx[t.typeIn], p, FALSE]; GenCtxVars[ArgCtx[t.typeOut], p, TRUE]}; ENDCASE; ENDCASE; GenCtxVars[bb[bti].localCtx, p, FALSE]}; GenBodyProcs: PROC[bti: BTIndex, proc: PROC[CBTIndex]] = { sonBti: BTIndex; IF (sonBti _ bb[bti].firstSon) # BTNull THEN DO WITH body: bb[sonBti] SELECT FROM Callable => IF ~body.inline THEN proc[LOOPHOLE[sonBti]]; ENDCASE => NULL; IF bb[sonBti].link.which = parent THEN EXIT; sonBti _ bb[sonBti].link.index; ENDLOOP}; GenImportedVars: PROC[p: VarScan] = { ctx: CTXIndex = dataPtr.importCtx; FOR sei: ISEIndex _ FirstCtxSe[ctx], NextSe[sei] UNTIL sei = ISENull DO IF ~seb[sei].constant THEN p[sei, FALSE] ELSE { type: CSEIndex = UnderType[seb[sei].idType]; WITH seb[type] SELECT FROM definition => GenCtxVars[defCtx, p, FALSE] ENDCASE}; ENDLOOP}; MarkArg: VarScan = {seb[sei].mark4 _ TRUE}; MarkArgs: PROC[sei: Type] = { type: CSEIndex = UnderType[sei]; rSei: RecordSEIndex; WITH t: seb[type] SELECT FROM transfer => { IF (rSei _ ArgRecord[t.typeIn]) # RecordSENull THEN { GenCtxVars[seb[rSei].fieldCtx, MarkArg, FALSE]; seb[rSei].length _ LayoutArgs[rSei, 0, TRUE]*WordLength; seb[rSei].mark4 _ TRUE}; IF (rSei _ ArgRecord[t.typeOut]) # RecordSENull THEN { GenCtxVars[seb[rSei].fieldCtx, MarkArg, TRUE]; seb[rSei].length _ LayoutArgs[rSei, 0, TRUE]*WordLength; seb[rSei].mark4 _ TRUE}; t.mark4 _ TRUE}; ENDCASE}; LayoutLocals: PUBLIC PROC[bti: CBTIndex] RETURNS[length: CARDINAL] = { vProfile: Profile; vI: CARDINAL; CountVar: VarScan = { IF seb[sei].hash # nullName OR seb[sei].extended OR ~output THEN vI _ vI + 1}; CountProc: PROC[bti: CBTIndex] = { IF bb[bti].info.mark = Internal THEN vI _ vI + 1}; InsertVar: VarScan = { saveIndex: SourceMap.Loc = dataPtr.textIndex; node: Tree.Index = LOOPHOLE[seb[sei].idValue]; IF node # Tree.NullIndex THEN dataPtr.textIndex _ tb[node].info; IF seb[sei].hash # nullName OR seb[sei].extended OR ~output THEN { vProfile[vI] _ [link: [symbol[sei]], key: seb[sei].idInfo]; vI _ vI+1}; IF seb[sei].idInfo = 0 AND seb[sei].hash # nullName AND ~output -- suppress message for return record AND node # Tree.NullIndex THEN Log.WarningSei[unusedId, sei]; seb[sei].idInfo _ WordsForField[sei]*WordLength; seb[sei].idValue _ 0; dataPtr.textIndex _ saveIndex}; InsertProc: PROC[bti: CBTIndex] = { IF bb[bti].info.mark = Internal THEN { vProfile[vI] _ VarInfo[ link: [body[bti]], key: WITH bb[bti] SELECT FROM Inner=>frameOffset, ENDCASE=>0]; vI _ vI+1}}; bodyType: Type = bb[bti].ioType; origin: CARDINAL _ IF bb[bti].level = lL THEN localOrigin ELSE localOrigin+WordLength; IF ~seb[bodyType].mark4 THEN MarkArgs[bodyType]; vI _ 0; GenBodyVars[bti, CountVar]; GenBodyProcs[bti, CountProc]; vProfile _ AllocateProfile[vI]; vI _ 0; GenBodyVars[bti, InsertVar]; GenBodyProcs[bti, InsertProc]; SortProfile[vProfile]; origin _ AssignVars[vProfile, origin, localOrigin + localSlots*WordLength]; length _ AssignVars[vProfile, origin, frameLimit]; CheckFrameOverflow[vProfile]; vProfile _ NIL; RETURN}; LayoutGlobals: PUBLIC PROC[bti: CBTIndex, stopping, fragments: BOOL] RETURNS[length: CARDINAL] = { vProfile, pProfile, xProfile: Profile; vI, pI, xI: CARDINAL; CountVar: VarScan = { ctx: CTXIndex = seb[sei].idCtx; IF ctxb[ctx].ctxType = imported OR ctx = dataPtr.importCtx THEN xI _ xI + 1 ELSE IF seb[sei].hash # nullName OR seb[sei].extended OR ~output THEN { IF seb[sei].public THEN pI _ pI + 1 ELSE vI _ vI + 1}; }; InsertVar: VarScan = { ctx: CTXIndex = seb[sei].idCtx; IF ctxb[ctx].ctxType = imported OR ctx = dataPtr.importCtx THEN { xProfile[xI] _ [link: [symbol[sei]], key: seb[sei].idInfo]; xI _ xI+1; IF seb[sei].idInfo = 0 AND ~seb[sei].public THEN Log.WarningSei[unusedId, sei]; seb[sei].idInfo _ WordsForField[sei]*WordLength} ELSE { saveIndex: SourceMap.Loc = dataPtr.textIndex; node: Tree.Index = LOOPHOLE[seb[sei].idValue]; IF node # Tree.NullIndex THEN dataPtr.textIndex _ tb[node].info; IF seb[sei].hash # nullName OR seb[sei].extended OR ~output THEN { IF seb[sei].public THEN { pProfile[pI] _ [link: [symbol[sei]], key: seb[sei].idInfo]; pI _ pI + 1} ELSE { vProfile[vI] _ [link: [symbol[sei]], key: seb[sei].idInfo]; vI _ vI + 1} }; IF seb[sei].idInfo = 0 AND ~dataPtr.interface AND ~seb[sei].public AND seb[sei].hash # nullName AND node # Tree.NullIndex THEN Log.WarningSei[unusedId, sei]; seb[sei].idInfo _ WordsForField[sei]*WordLength; seb[sei].idValue _ 0; dataPtr.textIndex _ saveIndex}}; origin: CARDINAL _ globalOrigin; IF ~seb[bb[bti].ioType].mark4 THEN ERROR; vI _ pI _ xI _ 0; GenBodyVars[bti, CountVar]; GenImportedVars[CountVar]; vProfile _ AllocateProfile[vI]; pProfile _ AllocateProfile[pI]; xProfile _ AllocateProfile[xI]; vI _ pI _ xI _ 0; GenBodyVars[bti, InsertVar]; GenImportedVars[InsertVar]; IF dataPtr.switches['s] THEN { SortProfile[vProfile]; SortProfile[pProfile]; SortProfile[xProfile]}; AssignImports[xProfile, 0, 256*PrincOps.ControlLink.SIZE*WordLength]; SELECT TRUE FROM -- adjust for system uses of global 0 stopping => origin _ origin + WordLength; fragments OR pProfile.length # 0 => <> <= 2*WordLength>> origin _ MAX[ AssignVars[vProfile, origin, globalOrigin+WordLength], globalOrigin+WordLength]; ENDCASE; IF pProfile.length # 0 THEN { vProfile _ MergeProfiles[vProfile, pProfile]; pProfile _ NIL}; origin _ AssignVars[vProfile, origin, frameLimit]; length _ MAX[origin, globalOrigin+WordLength]; CheckFrameOverflow[vProfile]; vProfile _ NIL; CheckFrameOverflow[xProfile]; xProfile _ NIL; RETURN}; CheckBlock: PUBLIC PROC[bti: BTIndex] = { CheckVar: VarScan = { saveIndex: SourceMap.Loc = dataPtr.textIndex; node: Tree.Index = LOOPHOLE[seb[sei].idValue]; IF node # Tree.NullIndex THEN { dataPtr.textIndex _ tb[node].info; IF seb[sei].idInfo = 0 THEN Log.WarningSei[unusedId, sei]}; dataPtr.textIndex _ saveIndex}; GenCtxVars[bb[bti].localCtx, CheckVar, FALSE]}; LayoutBlock: PUBLIC PROC[bti: BTIndex, origin: CARDINAL] RETURNS[length: CARDINAL] = { vProfile: Profile; vI: CARDINAL; CountVar: VarScan = {vI _ vI + 1}; CountProc: PROC[bti: CBTIndex] = { IF bb[bti].info.mark = Internal THEN vI _ vI + 1}; InsertVar: VarScan = { vProfile[vI] _ [link: [symbol[sei]], key: seb[sei].idInfo]; vI _ vI+1; seb[sei].idInfo _ WordsForField[sei]*WordLength; seb[sei].idValue _ 0}; InsertProc: PROC[bti: CBTIndex] = { IF bb[bti].info.mark = Internal THEN { vProfile[vI] _ VarInfo[ link: [body[bti]], key: WITH bb[bti] SELECT FROM Inner=>frameOffset, ENDCASE=>0]; vI _ vI+1}}; vI _ 0; GenCtxVars[bb[bti].localCtx, CountVar, FALSE]; GenBodyProcs[bti, CountProc]; vProfile _ AllocateProfile[vI]; vI _ 0; GenCtxVars[bb[bti].localCtx, InsertVar, FALSE]; GenBodyProcs[bti, InsertProc]; SortProfile[vProfile]; length _ AssignVars[vProfile, origin, frameLimit]; CheckFrameOverflow[vProfile]; vProfile _ NIL; RETURN}; LayoutInterface: PUBLIC PROC[bti: CBTIndex] RETURNS[nEntries: CARDINAL] = { epN: CARDINAL _ 0; FOR sei: ISEIndex _ FirstCtxSe[bb[bti].localCtx], NextSe[sei] UNTIL sei = ISENull DO SELECT LinkMode[sei] FROM val, ref => {seb[sei].linkSpace _ TRUE; seb[sei].idValue _ epN; epN _ epN + 1}; type => {seb[sei].idValue _ epN; epN _ epN + 1}; ENDCASE; ENDLOOP; IF (nEntries_epN) > BcdDefs.IRLinkLimit THEN Log.ErrorN[interfaceEntries, nEntries-BcdDefs.IRLinkLimit]; RETURN}; CheckFrameOverflow: PROC[profile: Profile] = { FOR i: INTEGER IN [0 .. profile.length) DO WITH profile[i].link SELECT FROM symbol => Log.ErrorSei[addressOverflow, index]; body => Log.ErrorSei[addressOverflow, bb[index].id]; ENDCASE; ENDLOOP}; Align: PROC[offset: CARDINAL, item: VarLink] RETURNS[CARDINAL] = { RETURN[WITH item SELECT FROM body => (offset+WordLength)/(4*WordLength)*(4*WordLength) + (2*WordLength), symbol => SELECT XferMode[seb[index].idType] FROM port => (offset+WordLength)/(4*WordLength)*(4*WordLength) + (2*WordLength), ENDCASE => offset, ENDCASE => offset]}; BitWidth: PROC[item: VarLink] RETURNS[CARDINAL] = { RETURN[WITH item SELECT FROM symbol => seb[index].idInfo, body => PrincOps.ControlLink.SIZE*WordLength, ENDCASE => 0]}; AssignBase: PROC[item: VarLink, base: CARDINAL] = { WITH item SELECT FROM symbol => { sei: ISEIndex = index; seb[sei].idValue _ BitAddress[wd:base/WordLength, bd:0]; seb[sei].mark4 _ TRUE}; body => { bti: CBTIndex = index; WITH bb[bti] SELECT FROM Inner => frameOffset _ base/WordLength ENDCASE => ERROR}; ENDCASE}; AssignVars: PROC[profile: Profile, origin, limit: CARDINAL] RETURNS[CARDINAL] = { start, base, length, remainder, delta: CARDINAL; i, j, next: INTEGER; t: VarLink; found, skips: BOOL; next _ 0; start _ origin; remainder _ IF origin < limit THEN limit - origin ELSE 0; WHILE next < profile.length DO i _ next; found _ skips _ FALSE; WHILE ~found AND i < profile.length DO IF (t _ profile[i].link) # [empty[]] THEN { base _ Align[start, t]; length _ BitWidth[t]; delta _ base - start; IF length + delta <= remainder THEN { limit: CARDINAL = base + length; subBase: CARDINAL _ start; nRefs: CARDINAL _ 0; FOR j _ i+1, j+1 WHILE j < profile.length AND subBase < limit DO IF profile[j].link # [empty[]] THEN { subLength: CARDINAL = BitWidth[profile[j].link]; subDelta: CARDINAL = Align[subBase, profile[j].link] - subBase; IF (subDelta + subLength) > (limit - subBase) THEN EXIT; subBase _ subBase + (subDelta + subLength); nRefs _ nRefs + profile[j].key}; ENDLOOP; IF nRefs <= profile[i].key OR ~dataPtr.switches['s] THEN { found _ TRUE; AssignBase[t, base]; profile[i].link _ [empty[]]; IF base # start AND dataPtr.switches['s] THEN [] _ AssignVars[profile, start, base]; start _ limit; remainder _ remainder - (length+delta)} ELSE IF ~skips THEN {skips _ TRUE; next _ i}}}; i _ i+1; IF ~skips THEN next _ i; ENDLOOP; ENDLOOP; RETURN[start]}; AssignImports: PROC[profile: Profile, origin, limit: CARDINAL] = { i, nProcs: CARDINAL _ profile.length; next: CARDINAL; t: VarLink; v: VarInfo; UNTIL i = 0 DO i _ i-1; t _ profile[i].link; WITH t SELECT FROM symbol => IF XferMode[seb[index].idType] # proc THEN { nProcs _ nProcs-1; v _ profile[i]; FOR j: CARDINAL IN [i..nProcs) DO profile[j] _ profile[j+1] ENDLOOP; profile[nProcs] _ v}; ENDCASE; ENDLOOP; <> dataPtr.linkCount _ profile.length; IF ~dataPtr.interface THEN CompilerUtil.AppendBCDWord[profile.length]; i _ profile.length; next _ MIN[origin + profile.length*PrincOps.ControlLink.SIZE*WordLength, limit]; UNTIL i = 0 OR next = origin DO i _ i-1; t _ profile[i].link; profile[i].link _ [empty[]]; IF ~dataPtr.interface THEN WITH t SELECT FROM symbol => { sei: ISEIndex = index; next _ next - seb[sei].idInfo; CompilerUtil.AppendBCDWord[seb[sei].idValue]; seb[sei].idValue _ BitAddress[wd: next/WordLength, bd: 0]; seb[sei].linkSpace _ TRUE}; ENDCASE; ENDLOOP}; <> LayoutArgs: PUBLIC PROC[argRecord: RecordSEIndex, origin: CARDINAL, body: BOOL] RETURNS[CARDINAL] = { w: CARDINAL _ origin; IF argRecord # RecordSENull THEN { ctx: CTXIndex = seb[argRecord].fieldCtx; FOR sei: ISEIndex _ FirstCtxSe[ctx], NextSe[sei] UNTIL sei = ISENull DO nW: FieldWordCount = WordsForField[sei]; IF nW = 0 THEN Log.ErrorSei[sizeClash, sei]; IF ~body THEN { seb[sei].idInfo _ nW*WordLength; seb[sei].idValue _ BitAddress[wd:w, bd:0]}; w _ w + nW; ENDLOOP}; RETURN[w]}; <> BitOffset: PROC[sei: ISEIndex] RETURNS[CARDINAL] = { t: BitAddress = seb[sei].idValue; RETURN[t.wd*WordLength + t.bd]}; BitsForField: PROC[sei: ISEIndex] RETURNS[nB: FieldBitCount] = { nBits: BitCount = BitsForType[seb[sei].idType]; IF nBits > FieldBitCount.LAST THEN { Log.ErrorSei[addressOverflow, sei]; nB _ 0} ELSE nB _ FieldBitCount[nBits]; RETURN}; ScanVariants: PROC[caseCtx: CTXIndex, proc: PROC[RecordSEIndex] RETURNS[BOOL]] RETURNS[BOOL] = { FOR sei: ISEIndex _ FirstCtxSe[caseCtx], NextSe[sei] UNTIL sei = ISENull DO rSei: Type = seb[sei].idInfo; WITH variant: seb[rSei] SELECT FROM cons => WITH variant SELECT FROM record => IF proc[LOOPHOLE[rSei]] THEN RETURN[TRUE]; ENDCASE => ERROR; ENDCASE => NULL; -- skip multiple identifiers ENDLOOP; RETURN[FALSE]}; LayoutFields: PUBLIC PROC[rSei: RecordSEIndex, offset: CARDINAL] = { maxRecordSize: CARDINAL = CARDINAL.LAST/WordLength + 1; w: WordCount; b: CARDINAL; lastFillable: BOOL; lastSei: ISEIndex; AssignField: PROC[sei: ISEIndex] = { OPEN id: seb[sei]; n: FieldBitCount; nW, nB: CARDINAL; saveIndex: SourceMap.Loc = dataPtr.textIndex; dataPtr.textIndex _ tb[LOOPHOLE[id.idValue, Tree.Index]].info; n _ BitsForField[sei]; nW _ n/WordLength; nB _ n MOD WordLength; IF nW > 0 AND nB # 0 THEN {nW _ nW+1; nB _ 0}; IF (nW > 0 OR b+nB > WordLength OR n = 0) AND b # 0 THEN {w _ w+1; b _ 0}; dataPtr.textIndex _ saveIndex; IF b = 0 AND lastFillable THEN FillWord[lastSei]; IF w >= maxRecordSize THEN Log.ErrorSei[addressOverflow, sei]; id.idInfo _ nW*WordLength + nB; id.idValue _ BitAddress[wd:w, bd:b]; lastSei _ sei; lastFillable _ (nW = 0 AND n # 0); w _ w + nW; b _ b + nB; IF b >= WordLength THEN {w _ w+1; b _ b - WordLength}; IF (IF b=0 THEN w ELSE w+1) >= maxRecordSize THEN Log.ErrorSei[addressOverflow, sei]}; FillWord: PROC[sei: ISEIndex] = { t: BitAddress = seb[sei].idValue; width: CARDINAL = WordLength - t.bd; IF seb[rSei].machineDep AND width # seb[sei].idInfo THEN Log.WarningSei[paddedField, sei]; seb[sei].idInfo _ width}; FindFit: PROC[vSei: RecordSEIndex] RETURNS[BOOL] = { sei: ISEIndex _ FirstCtxSe[seb[vSei].fieldCtx]; type: CSEIndex; IF sei = ISENull THEN RETURN[FALSE]; type _ UnderType[seb[sei].idType]; WITH seb[type] SELECT FROM union => IF controlled THEN sei _ tagSei ELSE RETURN[ScanVariants[caseCtx, FindFit]]; sequence => IF controlled THEN sei _ tagSei ELSE RETURN[FALSE]; ENDCASE => NULL; RETURN[BitsForType[seb[sei].idType] + b <= WordLength]}; vOrigin: CARDINAL; maxLength: CARDINAL; AssignVariant: PROC[vSei: RecordSEIndex] RETURNS[BOOL] = { LayoutFields[vSei, vOrigin]; maxLength _ MAX[seb[vSei].length, maxLength]; RETURN[FALSE]}; eqLengths: BOOL; padEnd: CARDINAL; PadVariant: PROC[vSei: RecordSEIndex] RETURNS[BOOL] = { fillSei: ISEIndex _ ISENull; type: CSEIndex; fillOrigin, currentEnd: CARDINAL; ctx: CTXIndex = seb[vSei].fieldCtx; FOR sei: ISEIndex _ FirstCtxSe[ctx], NextSe[sei] UNTIL sei = ISENull DO IF LOOPHOLE[seb[sei].idValue, BitAddress].wd # w THEN EXIT; fillSei _ sei; ENDLOOP; IF fillSei # ISENull THEN { fillOrigin _ BitOffset[fillSei]; currentEnd _ fillOrigin + seb[fillSei].idInfo; IF currentEnd < padEnd AND (currentEnd # 0 OR padEnd < WordLength) THEN { type _ UnderType[seb[fillSei].idType]; WITH seb[type] SELECT FROM union => { saveLastSei: ISEIndex = lastSei; IF controlled THEN lastSei _ tagSei; -- for messages only [] _ ScanVariants[caseCtx, PadVariant]; lastSei _ saveLastSei}; ENDCASE => IF seb[rSei].machineDep THEN Log.WarningSei[paddedField, fillSei]; seb[fillSei].idInfo _ padEnd - fillOrigin}} ELSE IF vOrigin < padEnd AND (vOrigin # 0 OR padEnd < WordLength) THEN { IF seb[rSei].machineDep THEN Log.WarningSei[paddedField, lastSei]; fillSei _ MakeCtxSe[nullName, CTXNull]; seb[fillSei].public _ TRUE; seb[fillSei].extended _ FALSE; seb[fillSei].constant _ seb[fillSei].immutable _ FALSE; seb[fillSei].linkSpace _ FALSE; seb[fillSei].idType _ dataPtr.idANY; seb[fillSei].idValue _ BitAddress[wd:w, bd:b]; seb[fillSei].idInfo _ padEnd - vOrigin; seb[fillSei].mark3 _ seb[fillSei].mark4 _ TRUE; WITH seb[fillSei] SELECT FROM linked => link _ ctxb[ctx].seList ENDCASE => ERROR; ctxb[ctx].seList _ fillSei}; seb[vSei].length _ MIN[ maxLength, (seb[vSei].length + wordFill)/WordLength * WordLength]; IF seb[vSei].length # maxLength THEN eqLengths _ FALSE; RETURN[FALSE]}; type: CSEIndex; ctx: CTXIndex = seb[rSei].fieldCtx; w _ offset/WordLength; b _ offset MOD WordLength; lastFillable _ FALSE; lastSei _ ISENull; FOR sei: ISEIndex _ FirstCtxSe[ctx], NextSe[sei] UNTIL sei = ISENull DO IF ~seb[sei].constant THEN { type _ UnderType[seb[sei].idType]; WITH seb[type] SELECT FROM union => { IF ~controlled THEN seb[sei].idValue _ BitAddress[wd:w, bd:b] ELSE {AssignField[tagSei]; seb[sei].idValue _ seb[tagSei].idValue}; IF lastFillable AND b # 0 AND ~ScanVariants[caseCtx, FindFit] THEN { FillWord[lastSei]; w _ w+1; b _ 0}; maxLength _ vOrigin _ w*WordLength + b; [] _ ScanVariants[caseCtx, AssignVariant]; padEnd _ IF maxLength < WordLength THEN maxLength ELSE MAX[(vOrigin + wordFill)/WordLength, 1]*WordLength; eqLengths _ TRUE; [] _ ScanVariants[caseCtx, PadVariant]; hints.equalLengths _ eqLengths; seb[sei].idInfo _ (maxLength - vOrigin) + (IF controlled THEN seb[tagSei].idInfo ELSE 0); w _ maxLength/WordLength; b _ maxLength MOD WordLength; lastFillable _ FALSE}; sequence => { IF ~controlled THEN seb[sei].idValue _ BitAddress[wd:w, bd:b] ELSE {AssignField[tagSei]; seb[sei].idValue _ seb[tagSei].idValue}; IF lastFillable AND b # 0 THEN {FillWord[lastSei]; w _ w+1; b _ 0}; seb[sei].idInfo _ (CARDINAL[w]*WordLength+b) - BitOffset[sei]; lastFillable _ FALSE}; ENDCASE => AssignField[sei]}; ENDLOOP; IF lastFillable AND b # 0 AND w > 0 THEN {FillWord[lastSei]; b _ 0; w _ w+1}; seb[rSei].length _ w*WordLength + b}; CheckFields: PUBLIC PROC[rSei: RecordSEIndex, origin: CARDINAL] = { vProfile: Profile; vI: CARDINAL; CountVar: VarScan = {vI _ vI + 1}; InsertVar: VarScan = { vProfile[vI] _ [link:[symbol[sei]], key:BitOffset[sei]]; vI _ vI+1}; b, newB: CARDINAL; sei, lastSei: ISEIndex; vI _ 0; GenCtxVars[seb[rSei].fieldCtx, CountVar, FALSE]; vProfile _ AllocateProfile[vI]; vI _ 0; GenCtxVars[seb[rSei].fieldCtx, InsertVar, FALSE]; SortProfile[vProfile]; b _ origin; lastSei _ ISENull; FOR vI DECREASING IN [0 .. vProfile.length) DO sei _ NARROW[vProfile[vI].link, VarLink.symbol].index; SELECT TypeForm[seb[sei].idType] FROM union => CheckVariants[sei]; sequence => { IF vI # 0 THEN Log.ErrorSei[recordOverlap, sei]; CheckSequence[sei]}; ENDCASE; SELECT (newB _ vProfile[vI].key) FROM > b => Log.ErrorSei[recordGap, lastSei]; < b => Log.ErrorSei[recordOverlap, sei]; ENDCASE; b _ newB + seb[sei].idInfo; lastSei _ sei; ENDLOOP; vProfile _ NIL; IF b > WordLength AND b MOD WordLength # 0 THEN { Log.ErrorSei[recordGap, lastSei]; b _ ((b+wordFill)/WordLength) * WordLength}; seb[rSei].length _ b}; CheckVariants: PROC[sei: ISEIndex] = { type: CSEIndex = UnderType[seb[sei].idType]; started: BOOL _ FALSE; eqLengths: BOOL _ TRUE; gaps: BOOL _ FALSE; origin, maxLength, size: CARDINAL; CheckVariant: PROC[rSei: RecordSEIndex] RETURNS[BOOL] = { length: CARDINAL; CheckFields[rSei, origin]; length _ seb[rSei].length; IF ~started THEN {maxLength _ length; started _ TRUE} ELSE { IF length MOD WordLength # 0 OR maxLength MOD WordLength # 0 THEN gaps _ TRUE; IF length # maxLength THEN {maxLength _ MAX[length, maxLength]; eqLengths _ FALSE}}; RETURN[FALSE]}; origin _ BitOffset[sei]; WITH union: seb[type] SELECT FROM union => { IF union.controlled THEN { newOrigin: CARDINAL = BitOffset[union.tagSei]; IF origin # newOrigin THEN Log.ErrorSei[fieldPosition, union.tagSei]; origin _ newOrigin + seb[union.tagSei].idInfo}; [] _ ScanVariants[union.caseCtx, CheckVariant]; size _ maxLength - BitOffset[sei]; union.hints.equalLengths _ eqLengths; IF gaps THEN Log.ErrorSei[recordGap, sei]; SELECT TRUE FROM (seb[sei].idInfo = 0) => seb[sei].idInfo _ size; (size # seb[sei].idInfo) => Log.ErrorSei[fieldPosition, sei]; ENDCASE}; ENDCASE => ERROR}; CheckSequence: PROC[sei: ISEIndex] = { type: CSEIndex = UnderType[seb[sei].idType]; origin, length: CARDINAL; origin _ BitOffset[sei]; WITH seq: seb[type] SELECT FROM sequence => { IF seq.controlled THEN { newOrigin: CARDINAL = BitOffset[seq.tagSei]; IF origin # newOrigin THEN Log.ErrorSei[fieldPosition, seq.tagSei]; origin _ newOrigin + seb[seq.tagSei].idInfo}; IF origin MOD WordLength # 0 THEN Log.ErrorSei[fieldPosition, sei]; length _ origin - BitOffset[sei]; SELECT seb[sei].idInfo FROM 0 => seb[sei].idInfo _ length; length => NULL; ENDCASE => Log.ErrorSei[fieldPosition, sei]}; ENDCASE => ERROR}; }.