DIRECTORY Alloc: TYPE USING [Notifier], Basics: TYPE USING [bitsPerWord], BcdDefs: TYPE USING [Link], Code: TYPE USING [ caseCVState, CodeNotImplemented, mwCaseCV, tailJumpOK, xtracting, xtractlex], CodeDefs: TYPE USING [ Base, Byte, codeType, Lexeme, NullLex, OpWordCount, StoreOptions, VarComponent, VarIndex], ComData: TYPE USING [bodyIndex, switches], FOpCodes: TYPE USING [ qADD, qAND, qBNDCK, qDADD, qDDIV, qDESCB, qDESCBS, qDIV, qDMOD, qDMUL, qDSUB, qDUDIV, qDUMOD, qEXCH, qFADD, qFDIV, qFLOAT, qFMUL, qFREE, qFSUB, qFSC, qLI, qMUL, qNEG, qNILCK, qNILCKL, qPOP, qPUSH, qSDIV, qSHIFT, qSUB], Literals: TYPE USING [Base, LTIndex, ltType], LiteralOps: TYPE USING [WordIndex], OpCodeParams: TYPE USING [GlobalHB, LocalHB], P5: TYPE USING [ All, BindStmtExp, CaseStmtExp, Construct, FlowExp, GenTempLex, GetCanonicalType, LogHeapFree, MoveToCodeWord, NarrowExp, New, P5Error, PushLex, RowCons, TTAssign, WriteCodeWord], P5L: TYPE USING [ AddrForVar, AdjustComponent, ComponentForLex, ComponentForSE, CopyLex, CopyToTemp, EasilyLoadable, FieldOfVarOnly, GenVarItem, LoadBoth, LoadComponent, LoadVar, MakeComponent, OVarItem, TOSComponent, TOSLex, VarAlignment, VarForLex, Words], P5S: TYPE USING [ AssignExp, BodyInit, CallExp, Create, DIndex, ErrExp, ExtractExp, ForkExp, Index, JoinExp, ProcCheck, SeqIndex, SigExp, StartExp, StringInit, SubstExp, SysErrExp], P5U: TYPE USING [ OperandType, Out0, Out1, PushLitVal, RecordConstant, TreeLiteral, TreeLiteralValue, WordsForOperand, WordsForSei], PrincOps: TYPE USING [EPRange, wordsPerPage], PrincOpsUtils: TYPE USING [BITAND, BITSHIFT], Real: FROM "IeeeFloat" USING [Extended, RealToExtended], Stack: TYPE USING [Dump, RoomFor], SymbolOps: TYPE USING [FnField, NormalType, UnderType, WordsForType, XferMode], Symbols: TYPE USING [ Base, BitAddress, bodyType, CBTIndex, CBTNull, ContextLevel, CSEIndex, ISEIndex, lZ, RecordSEIndex, seType], Tree: TYPE USING [Base, Index, Link, Null, treeType], TreeOps: TYPE USING [GetNode, GetSe, NthSon, OpName]; Expression: PROGRAM IMPORTS CPtr: Code, MPtr: ComData, LiteralOps, P5, P5L, P5S, P5U, PrincOpsUtils, Real, Stack, SymbolOps, TreeOps EXPORTS CodeDefs, P5 = BEGIN OPEN FOpCodes, CodeDefs; wordlength: CARDINAL = Basics.bitsPerWord; firstMappedAddress: CARDINAL = PrincOps.wordsPerPage; LocalHB: TYPE = OpCodeParams.LocalHB; GlobalHB: TYPE = OpCodeParams.GlobalHB; ExprOptions: CodeDefs.StoreOptions = [expr: TRUE, init: TRUE]; BitAddress: TYPE = Symbols.BitAddress; CBTIndex: TYPE = Symbols.CBTIndex; CBTNull: CBTIndex = Symbols.CBTNull; ContextLevel: TYPE = Symbols.ContextLevel; CSEIndex: TYPE = Symbols.CSEIndex; RecordSEIndex: TYPE = Symbols.RecordSEIndex; ISEIndex: TYPE = Symbols.ISEIndex; lZ: ContextLevel = Symbols.lZ; LTIndex: TYPE = Literals.LTIndex; tb: Tree.Base; -- tree base (local copy) seb: Symbols.Base; -- semantic entry base (local copy) bb: Symbols.Base; -- body entry base (local copy) cb: CodeDefs.Base; -- code base (local copy) ltb: Literals.Base; -- literal base (local copy) ExpressionNotify: PUBLIC Alloc.Notifier = BEGIN -- called by allocator whenever table area is repacked seb _ base[Symbols.seType]; bb _ base[Symbols.bodyType]; tb _ base[Tree.treeType]; cb _ base[codeType]; ltb _ base[Literals.ltType]; END; recentExp: PUBLIC Tree.Link; -- for debugging Exp: PUBLIC PROC [t: Tree.Link] RETURNS [l: Lexeme] = BEGIN -- generates code for an expression node: Tree.Index; WITH e: t SELECT FROM literal => WITH e.index SELECT FROM word => RETURN [Lexeme[literal[word[lti]]]]; string => RETURN [Lexeme[literal[string[sti]]]]; ENDCASE; symbol => RETURN [Lexeme[se[e.index]]]; subtree => BEGIN recentExp _ t; IF e = Tree.Null THEN IF CPtr.xtracting THEN RETURN [CPtr.xtractlex] ELSE BEGIN SELECT CPtr.caseCVState FROM single => P5U.Out0[qPUSH]; singleLoaded => CPtr.caseCVState _ single; multi => RETURN [P5L.CopyLex[CPtr.mwCaseCV]]; ENDCASE => ERROR; RETURN [P5L.TOSLex[1]]; END; node _ e.index; SELECT tb[node].name FROM casex => l _ P5.CaseStmtExp[node, TRUE]; bindx => l _ P5.BindStmtExp[node, TRUE]; assignx => l _ P5S.AssignExp[node]; extractx => l _ P5S.ExtractExp[node]; plus => l _ Plus[node]; minus => l _ Minus[node]; div => l _ Div[node]; mod => l _ Mod[node]; times => l _ Times[node]; dot, uparrow => l _ DotOrUparrow[node]; reloc => l _ Reloc[node]; dollar => l _ Dollar[node]; uminus => l _ UMinus[node]; addr => l _ Addr[node]; index => l _ P5S.Index[node]; dindex => l _ P5S.DIndex[node]; construct => l _ P5.Construct[Tree.Null, node, ExprOptions]; arraydesc => l _ ArrayDesc[node]; length => l _ Length[node]; base => l _ Base[node]; body => l _ P5S.BodyInit[node]; rowcons => l _ P5.RowCons[Tree.Null, node, ExprOptions]; stringinit => l _ P5S.StringInit[node]; pad => BEGIN psei: CSEIndex = tb[node].info; tlex: se Lexeme = P5.GenTempLex[SymbolOps.WordsForType[psei]]; P5.TTAssign[[symbol[tlex.lexsei]], t]; l _ tlex; END; ord, val, cast, loophole => l _ Exp[tb[node].son[1]]; safen => l _ Safen[node]; seqindex => l _ P5S.SeqIndex[node]; item => l _ Exp[tb[node].son[2]]; callx, portcallx => l _ P5S.CallExp[node]; substx => l _ P5S.SubstExp[node]; signalx => l _ P5S.SigExp[node]; errorx => l _ P5S.ErrExp[node]; syserrorx => l _ P5S.SysErrExp[node]; startx => l _ P5S.StartExp[node]; new => l _ P5.New[node]; create => l _ P5S.Create[node]; mwconst => l _ MwConst[node]; signalinit => l _ SignalInit[node]; fork => l _ P5S.ForkExp[node]; joinx => l _ P5S.JoinExp[node]; float => l _ Float[node]; narrow => l _ P5.NarrowExp[node]; check => BEGIN nw: CARDINAL = P5U.WordsForOperand[tb[node].son[1]]; PushRhs[tb[node].son[1]]; PushRhs[tb[node].son[2]]; P5U.Out0[FOpCodes.qBNDCK]; l _ P5L.TOSLex[nw]; END; proccheck => l _ P5S.ProcCheck[node]; chop => BEGIN len: CARDINAL = P5U.WordsForSei[tb[node].info]; r: VarIndex = P5L.VarForLex[Exp[tb[node].son[1]]]; P5L.FieldOfVarOnly[r: r, wSize: len]; l _ [bdo[r]]; END; all => l _ P5.All[Tree.Null, node, ExprOptions]; gcrt => l _ P5.GetCanonicalType[node]; ENDCASE => l _ P5.FlowExp[node]; END; ENDCASE; RETURN END; ConstOperand: PROC [t: Tree.Link] RETURNS [BOOL, INTEGER] = BEGIN -- if t is a literal node, return [TRUE,val(t)] IF P5U.TreeLiteral[t] THEN RETURN [TRUE, P5U.TreeLiteralValue[t]] ELSE RETURN [FALSE, 0] END; Plus: PROC [node: Tree.Index] RETURNS [Lexeme] = BEGIN -- generate code for + op: Byte; nw: [1..2]; op1, op2: VarComponent; SELECT TRUE FROM tb[node].attr1 => {IF ~MPtr.switches['f] THEN Stack.Dump[]; nw _ 2; op _ qFADD}; tb[node].attr2 => {nw _ 2; op _ qDADD}; ENDCASE => {nw _ 1; op _ qADD}; op1 _ P5L.ComponentForLex[Exp[tb[node].son[1]]]; op2 _ P5L.ComponentForLex[Exp[tb[node].son[2]]]; P5L.LoadBoth[@op1, @op2, TRUE]; P5U.Out0[op]; RETURN [P5L.TOSLex[nw]] END; Minus: PROC [node: Tree.Index] RETURNS [Lexeme] = BEGIN -- generate code for (binary) - op: Byte; nw: [1..2]; SELECT TRUE FROM tb[node].attr1 => {IF ~MPtr.switches['f] THEN Stack.Dump[]; nw _ 2; op _ qFSUB}; tb[node].attr2 => {nw _ 2; op _ qDSUB}; ENDCASE => {nw _ 1; op _ qSUB}; IF ~Stack.RoomFor[2*nw] THEN Stack.Dump[]; PushRhs[tb[node].son[1]]; PushRhs[tb[node].son[2]]; P5U.Out0[op]; RETURN [P5L.TOSLex[nw]] END; UMinus: PROC [node: Tree.Index] RETURNS [Lexeme] = BEGIN -- generate code for (unary) - tt: Tree.Link = tb[node].son[1]; real: BOOL = tb[node].attr1; nw: [1..2] = IF real OR tb[node].attr2 THEN 2 ELSE 1; IF TreeOps.OpName[tt] = uminus THEN BEGIN subNode: Tree.Index = TreeOps.GetNode[tt]; PushRhs[tb[subNode].son[1]]; END ELSE BEGIN IF nw = 2 THEN BEGIN IF real AND ~MPtr.switches['f] THEN Stack.Dump[]; P5U.PushLitVal[0]; P5U.PushLitVal[0]; END; PushRhs[tt]; P5U.Out0[IF nw = 2 THEN (IF real THEN qFSUB ELSE qDSUB) ELSE qNEG]; END; RETURN [P5L.TOSLex[nw]] END; Times: PROC [node: Tree.Index] RETURNS [Lexeme] = BEGIN -- generates code for * op: Byte; nw: [1..2]; op1, op2: VarComponent; SELECT TRUE FROM tb[node].attr1 => {IF ~MPtr.switches['f] THEN Stack.Dump[]; nw _ 2; op _ qFMUL}; tb[node].attr2 => {Stack.Dump[]; nw _ 2; op _ qDMUL}; ENDCASE => {nw _ 1; op _ qMUL}; SELECT op FROM qFMUL => IF MPtr.switches['f] THEN BEGIN rand2lit: BOOL; rand2val: Real.Extended; [rand2lit, rand2val] _ RealConst[tb[node].son[2]]; IF rand2lit AND Power2[rand2val] AND rand2val.exp IN [-200b..200b] THEN BEGIN PushRhs[tb[node].son[1]]; P5U.PushLitVal[rand2val.exp]; P5U.Out0[qFSC]; RETURN [P5L.TOSLex[nw]] END; END; ENDCASE; op1 _ P5L.ComponentForLex[Exp[tb[node].son[1]]]; op2 _ P5L.ComponentForLex[Exp[tb[node].son[2]]]; P5L.LoadBoth[@op1, @op2, TRUE]; P5U.Out0[op]; RETURN [P5L.TOSLex[nw]] END; Log2: PROC [i: INTEGER] RETURNS [BOOL, [0..16]] = BEGIN OPEN PrincOpsUtils; shift: [0..16]; IF i = 0 THEN RETURN [FALSE, 0]; i _ ABS[i]; IF BITAND[i, i-1] # 0 THEN RETURN [FALSE, 0]; FOR shift IN [0..16) DO IF BITAND[i,1] = 1 THEN RETURN [TRUE, shift]; i _ BITSHIFT[i, -1]; ENDLOOP; ERROR; -- can't get here, but it makes the compiler happy END; Power2: PROC [v: Real.Extended] RETURNS [BOOL] = BEGIN FractionOne: LONG CARDINAL = 20000000000b; RETURN [v.type = normal AND ~v.sign AND v.frac = FractionOne] END; Div: PROC [node: Tree.Index] RETURNS [Lexeme] = BEGIN -- generate code for / signed: BOOL = tb[node].attr3; op: Byte; nw: [1..2]; SELECT TRUE FROM tb[node].attr1 => {IF ~MPtr.switches['f] THEN Stack.Dump[]; nw _ 2; op _ qFDIV}; tb[node].attr2 => {Stack.Dump[]; nw _ 2; op _ IF signed THEN qDDIV ELSE qDUDIV}; ENDCASE => {nw _ 1; op _ IF signed THEN qSDIV ELSE qDIV}; IF ~Stack.RoomFor[2*nw] THEN Stack.Dump[]; PushRhs[tb[node].son[1]]; SELECT op FROM qDIV => BEGIN rand2lit: BOOL; rand2val: INTEGER; [rand2lit, rand2val] _ ConstOperand[tb[node].son[2]]; IF rand2lit AND rand2val > 0 THEN BEGIN powerof2: BOOL; shift: [0..16]; [powerof2, shift] _ Log2[rand2val]; IF powerof2 THEN BEGIN P5U.PushLitVal[-shift]; P5U.Out0[qSHIFT]; RETURN [P5L.TOSLex[nw]] END; END; END; qFDIV => IF MPtr.switches['f] THEN BEGIN rand2lit: BOOL; rand2val: Real.Extended; [rand2lit, rand2val] _ RealConst[tb[node].son[2]]; IF rand2lit AND Power2[rand2val] AND rand2val.exp IN [-200b..200b] THEN BEGIN P5U.PushLitVal[-rand2val.exp]; P5U.Out0[qFSC]; RETURN [P5L.TOSLex[nw]] END; END; ENDCASE; PushRhs[tb[node].son[2]]; P5U.Out0[op]; RETURN [P5L.TOSLex[nw]]; END; Mod: PROC [node: Tree.Index] RETURNS [Lexeme] = BEGIN -- generate code for MOD real: BOOL = tb[node].attr1; double: BOOL = real OR tb[node].attr2; signed: BOOL = tb[node].attr3; rand2lit, powerof2: BOOL; rand2val: INTEGER; IF double THEN BEGIN IF real THEN SIGNAL CPtr.CodeNotImplemented; Stack.Dump[]; END; PushRhs[tb[node].son[1]]; IF ~double AND ~signed THEN BEGIN [rand2lit, rand2val] _ ConstOperand[tb[node].son[2]]; IF rand2lit AND rand2val > 0 THEN BEGIN [powerof2, ] _ Log2[rand2val]; IF powerof2 THEN BEGIN P5U.PushLitVal[rand2val-1]; P5U.Out0[qAND]; RETURN [P5L.TOSLex[1]]; END; END; END; PushRhs[tb[node].son[2]]; IF double THEN BEGIN P5U.Out0[IF signed THEN qDMOD ELSE qDUMOD]; RETURN [P5L.TOSLex[2]]; END; P5U.Out0[IF signed THEN qSDIV ELSE qDIV]; P5U.Out0[qPUSH]; P5U.Out0[qEXCH]; P5U.Out0[qPOP]; RETURN [P5L.TOSLex[1]]; END; StoreMod: PUBLIC PROC [t: Tree.Link, bSize: [0..wordlength)] RETURNS [Tree.Link] = BEGIN -- see if store into field with width bSize performs the MOD operation IF TreeOps.OpName[t] # mod THEN RETURN [t] ELSE BEGIN node: Tree.Index = TreeOps.GetNode[t]; t2: Tree.Link = tb[node].son[2]; powerof2: BOOL _ FALSE; log: [0..16]; IF P5U.TreeLiteral[t2] THEN [powerof2, log] _ Log2[P5U.TreeLiteralValue[t2]]; RETURN [IF ~tb[node].attr3 AND powerof2 AND log = bSize THEN tb[node].son[1] ELSE t] END; END; Float: PROC [node: Tree.Index] RETURNS [Lexeme] = BEGIN IF ~MPtr.switches['f] THEN Stack.Dump[]; PushRhs[tb[node].son[1]]; P5U.Out0[qFLOAT]; RETURN [P5L.TOSLex[2]] END; Safen: PROC [node: Tree.Index] RETURNS [Lexeme] = BEGIN var: VarComponent = P5L.ComponentForLex[Exp[tb[node].son[1]]]; RETURN [[bdo[P5L.OVarItem[P5L.EasilyLoadable[var, store]]]]] END; Addr: PROC [node: Tree.Index] RETURNS [Lexeme] = BEGIN -- generates code for "@" r: VarIndex = P5L.VarForLex[Exp[tb[node].son[1]]]; avar: VarComponent = P5L.AddrForVar[r]; WITH vv: avar SELECT FROM frame, caddr, link => NULL; faddr => IF vv.level = bb[MPtr.bodyIndex].level THEN CPtr.tailJumpOK _ FALSE; ENDCASE => CPtr.tailJumpOK _ FALSE; -- conservative RETURN [[bdo[P5L.OVarItem[avar]]]] END; ArrayDesc: PROC [node: Tree.Index] RETURNS [Lexeme] = BEGIN -- pushes two components of an array descriptor onto stack subNode: Tree.Index = TreeOps.GetNode[tb[node].son[1]]; size: CARDINAL; size _ SPushRhs[tb[subNode].son[1]]; size _ SPushRhs[tb[subNode].son[2]] + size; RETURN [P5L.TOSLex[size]] END; Length: PROC [node: Tree.Index] RETURNS [Lexeme] = BEGIN -- generates code to extract length from array descriptor t1: Tree.Link = tb[node].son[1]; pW: CARDINAL = P5U.WordsForOperand[t1] - 1; r: VarIndex = P5L.VarForLex[Exp[t1]]; P5L.FieldOfVarOnly[r: r, wd: pW, wSize: 1]; RETURN [[bdo[r]]] END; Base: PROC [node: Tree.Index] RETURNS [Lexeme] = BEGIN -- generates code to extract base from array descriptor t1: Tree.Link = tb[node].son[1]; pW: CARDINAL = P5U.WordsForOperand[t1] - 1; r: VarIndex = P5L.VarForLex[Exp[t1]]; P5L.FieldOfVarOnly[r: r, wSize: pW]; RETURN [[bdo[r]]] END; DotOrUparrow: PROC [mainnode: Tree.Index] RETURNS [Lexeme] = BEGIN t1: Tree.Link = tb[mainnode].son[1]; r: VarIndex; long: BOOL = tb[mainnode].attr2; nilCheck: BOOL; base: VarComponent; offset: VarComponent; w, b: CARDINAL; IF tb[mainnode].name = uparrow THEN BEGIN w _ P5U.WordsForSei[tb[mainnode].info]; b _ 0; offset _ [wSize: w, space: frame[wd: 0]]; END ELSE BEGIN sei: ISEIndex = TreeOps.GetSe[tb[mainnode].son[2]]; IF seb[sei].constant THEN -- procedure or signal from pointer to frame RETURN [ConstantField[t1, sei, tb[mainnode].attr1, long]] ELSE BEGIN psei: CSEIndex = SymbolOps.NormalType[P5U.OperandType[t1]]; offset _ P5L.ComponentForSE[sei]; WITH o: offset SELECT FROM frame => BEGIN o.level _ lZ; -- to take care of pointer to frame w _ o.wd + o.wSize; b _ o.bd + o.bSize; END; ENDCASE => ERROR; -- fields of code data are dollar nodes WITH seb[psei] SELECT FROM ref => BEGIN OPEN SymbolOps; rcsei: CSEIndex = UnderType[refType]; WITH seb[rcsei] SELECT FROM record => P5L.AdjustComponent[var: @offset, rSei: LOOPHOLE[rcsei], fSei: sei, tBits: WordsForType[rcsei]*wordlength]; ENDCASE; END; ENDCASE => P5.P5Error[642]; END; END; IF tb[mainnode].attr1 THEN BEGIN -- nil checking, see if hardware will do it tsei: CSEIndex = tb[mainnode].info; nilCheck _ ~MPtr.switches['a] OR P5L.Words[w+b/wordlength, b MOD wordlength] > firstMappedAddress OR (WITH t: seb[tsei] SELECT FROM sequence => TRUE, array => SymbolOps.WordsForType[tsei] NOT IN (0..OpWordCount.LAST], record, union => tb[mainnode].name = uparrow, ENDCASE => FALSE); END ELSE nilCheck _ FALSE; SELECT TRUE FROM nilCheck => BEGIN PushRhs[t1]; P5U.Out0[IF long THEN FOpCodes.qNILCKL ELSE FOpCodes.qNILCK]; base _ P5L.TOSComponent[IF long THEN 2 ELSE 1]; r _ P5L.GenVarItem[bo]; cb[r] _ [body: bo[base: base, offset: offset]]; END; (TreeOps.OpName[t1] = plus) => BEGIN subNode: Tree.Index = TreeOps.GetNode[t1]; disp: VarComponent; base _ P5L.ComponentForLex[Exp[tb[subNode].son[1]]]; disp _ P5L.ComponentForLex[Exp[tb[subNode].son[2]]]; r _ P5L.GenVarItem[bdo]; cb[r] _ [body: bdo[base: base, disp: disp, offset: offset]]; END; ENDCASE => BEGIN base _ P5L.ComponentForLex[Exp[t1]]; r _ P5L.GenVarItem[bo]; cb[r] _ [body: bo[base: base, offset: offset]]; END; RETURN [[bdo[r]]] END; AdjustNilCheck: PUBLIC PROC [t: Tree.Link, wordOffset: CARDINAL] = BEGIN -- used by SeqIndex to suppress nil check if bound (at offset) is checked SELECT TreeOps.OpName[t] FROM dollar => AdjustNilCheck[TreeOps.NthSon[t, 1], wordOffset]; dot, uparrow => IF MPtr.switches['a] AND wordOffset < firstMappedAddress THEN BEGIN subNode: Tree.Index = TreeOps.GetNode[t]; tb[subNode].attr1 _ FALSE; END; ENDCASE; END; Reloc: PUBLIC PROC [node: Tree.Index] RETURNS [Lexeme] = BEGIN -- generates code for "baseptr[relptr]" rd, rr: VarIndex; base: VarComponent _ P5L.ComponentForLex[Exp[tb[node].son[1]]]; disp: VarComponent; rd _ P5L.VarForLex[Exp[tb[node].son[2]]]; IF tb[node].attr1 THEN BEGIN -- reloc of an array descriptor dsize: CARDINAL = P5U.WordsForOperand[tb[node].son[2]] - 1; P5L.FieldOfVarOnly[r: rd, wSize: dsize]; END; disp _ P5L.MakeComponent[rd]; rr _ P5L.GenVarItem[bdo]; cb[rr] _ [body: bdo[base: base, disp: disp, offset: [wSize: SymbolOps.WordsForType[tb[node].info], space: frame[]]]]; RETURN [[bdo[rr]]] END; ConstantField: PROC [t: Tree.Link, sei: ISEIndex, nilCheck, long: BOOL] RETURNS [Lexeme] = BEGIN SELECT SymbolOps.XferMode[seb[sei].idType] FROM proc => BEGIN bti: CBTIndex = seb[sei].idInfo; IF seb[sei].extended THEN SIGNAL CPtr.CodeNotImplemented; IF bti = CBTNull THEN RETURN [[bdo[P5L.OVarItem[ [wSize: 1, space: const[d1: seb[sei].idValue]]]]]]; IF long THEN SIGNAL CPtr.CodeNotImplemented; PushRhs[t]; IF nilCheck THEN P5U.Out0[FOpCodes.qNILCK]; WITH bb[bti] SELECT FROM Inner => BEGIN -- could happen with pointer to procedure frame P5U.Out1[FOpCodes.qLI, frameOffset]; P5U.Out0[FOpCodes.qADD]; END; Outer => P5U.Out1[qDESCBS, entryIndex]; ENDCASE; END; signal, error => BEGIN lnk: BcdDefs.Link = seb[sei].idValue; IF long THEN SIGNAL CPtr.CodeNotImplemented; PushRhs[t]; IF nilCheck THEN P5U.Out0[FOpCodes.qNILCK]; P5U.Out1[qDESCBS, (lnk.gfi-1)*PrincOps.EPRange + lnk.ep]; END; ENDCASE => P5.P5Error[643]; RETURN [P5L.TOSLex[1]] END; Dollar: PROC [node: Tree.Index] RETURNS [Lexeme] = BEGIN -- generates code for "exp$field" sei: ISEIndex = TreeOps.GetSe[tb[node].son[2]]; r: VarIndex; l: Lexeme; recsei: RecordSEIndex = LOOPHOLE[P5U.OperandType[tb[node].son[1]]]; functionCall: BOOL = seb[recsei].argument; tBits, twSize: CARDINAL; tbSize: [0..wordlength); foffset: frame VarComponent; hlex: se Lexeme _ NullLex; IF seb[sei].constant THEN BEGIN subNode: Tree.Index = TreeOps.GetNode[tb[node].son[1]]; IF tb[subNode].name # uparrow THEN P5.P5Error[645]; RETURN [ConstantField[ tb[subNode].son[1], sei, tb[subNode].attr1, tb[subNode].attr2]] END; l _ Exp[tb[node].son[1] ! P5.LogHeapFree => IF calltree = tb[node].son[1] THEN BEGIN logged: BOOL; lex: se Lexeme; [logged, lex] _ SIGNAL P5.LogHeapFree[calltree]; IF logged THEN RESUME [TRUE, lex]; hlex _ P5.GenTempLex[1]; RESUME [TRUE, hlex] END]; r _ P5L.VarForLex[l]; [wSize: twSize, bSize: tbSize] _ P5L.VarAlignment[r, load]; tBits _ twSize*wordlength + tbSize; IF functionCall THEN BEGIN fSize: CARDINAL; fAddr: BitAddress; [fAddr,fSize] _ SymbolOps.FnField[sei]; foffset _ [wSize: fSize / wordlength, bSize: fSize MOD wordlength, space: frame[wd: fAddr.wd, bd: fAddr.bd]]; END ELSE foffset _ LOOPHOLE[P5L.ComponentForSE[sei]]; IF tBits <= wordlength THEN P5L.AdjustComponent[var: @foffset, rSei: recsei, fSei: sei, tBits: tBits]; P5L.FieldOfVarOnly[r: r, wSize: foffset.wSize, bSize: foffset.bSize, wd: foffset.wd, bd: foffset.bd]; IF hlex # NullLex THEN BEGIN r _ P5L.OVarItem[P5L.CopyToTemp[r].var]; P5.PushLex[hlex]; P5U.Out0[FOpCodes.qFREE]; END; RETURN [[bdo[r]]] END; MwConst: PROC [node: Tree.Index] RETURNS [l: Lexeme] = BEGIN -- puts multi-word constant out to code stream lti: LTIndex = LiteralOps.WordIndex[NARROW[tb[node].son[1], Tree.Link.literal].index]; WITH ll: ltb[lti] SELECT FROM short => RETURN [[literal[word[lti]]]]; long => BEGIN var: VarComponent; SELECT ll.length FROM 0 => P5.P5Error[649]; 1 => var _ [wSize: 1, space: const[d1: ll.value[0]]]; 2 => var _ [wSize: 2, space: const[d1: ll.value[0], d2: ll.value[1]]]; ENDCASE => BEGIN nwords: CARDINAL = ll.length; IF ll.codeIndex = 0 THEN BEGIN ll.codeIndex _ P5.MoveToCodeWord[]; FOR i: CARDINAL IN [0..nwords) DO P5.WriteCodeWord[ll.value[i]] ENDLOOP; P5U.RecordConstant[ll.codeIndex, nwords]; END; var _ [wSize: nwords, space: code[wd: ll.codeIndex, lti: lti]]; END; RETURN [[bdo[P5L.OVarItem[var]]]]; END; ENDCASE => ERROR; -- to keep the compiler happy END; MultiZero: PUBLIC PROC [t: Tree.Link, minWords: CARDINAL] RETURNS [BOOL] = BEGIN IF TreeOps.OpName[t] = mwconst THEN BEGIN s: Tree.Link = TreeOps.NthSon[t, 1]; WITH s SELECT FROM literal => WITH l: index SELECT FROM word => BEGIN lti: LTIndex = l.lti; WITH ll: ltb[lti] SELECT FROM long => FOR i: CARDINAL IN [0 .. ll.length) DO IF ll.value[i] # 0 THEN EXIT; REPEAT FINISHED => RETURN [ll.length >= minWords] ENDLOOP; ENDCASE; END; ENDCASE; ENDCASE; END ELSE IF minWords <= 1 AND P5U.TreeLiteral[t] THEN RETURN [P5U.TreeLiteralValue[t] = 0]; RETURN [FALSE] END; RealConst: PUBLIC PROC [t: Tree.Link] RETURNS [BOOL, Real.Extended] = BEGIN IF TreeOps.OpName[t] = mwconst THEN BEGIN s: Tree.Link = TreeOps.NthSon[t, 1]; v: ARRAY [0..2) OF WORD; lti: LTIndex = LiteralOps.WordIndex[NARROW[s, Tree.Link.literal].index]; WITH ll:ltb[lti] SELECT FROM long => SELECT ll.length FROM 2 => {v[0] _ ll.value[0]; v[1] _ ll.value[1]}; ENDCASE => ERROR; ENDCASE => ERROR; RETURN [TRUE, Real.RealToExtended[LOOPHOLE[v]]] END; RETURN [FALSE, [nan, FALSE, 0, 0]] END; LPushRhs: PUBLIC PROC [t: Tree.Link] RETURNS [Lexeme] = BEGIN -- forces a value onto the stack wSize: CARDINAL = SPushRhs[t]; RETURN [P5L.TOSLex[wSize]] END; PushRhs: PUBLIC PROC [t: Tree.Link] = BEGIN -- forces a value onto the stack [] _ SPushRhs[t]; END; SPushRhs: PROC [t: Tree.Link] RETURNS [wSize: CARDINAL] = BEGIN -- forces a value onto the stack RETURN [SPushLex[Exp[t]]] END; SPushLex: PROC [l: Lexeme] RETURNS [wSize: CARDINAL] = BEGIN -- forces a lexeme onto the stack r: VarIndex = P5L.VarForLex[l]; ws, bs: CARDINAL; [wSize: ws, bSize: bs] _ P5L.VarAlignment[r,load]; wSize _ P5L.Words[ws, bs]; P5L.LoadVar[r]; RETURN END; PushLex: PUBLIC PROC [l: Lexeme] = {[] _ SPushLex[l]}; LPushLex: PUBLIC PROC [l: Lexeme] RETURNS [Lexeme] = BEGIN wSize: CARDINAL = SPushLex[l]; RETURN [P5L.TOSLex[wSize]]; END; PushLProcDesc: PUBLIC PROC [bti: CBTIndex] = BEGIN -- pushes a descriptor for local procedure on stack WITH body: bb[bti] SELECT FROM Inner => PushNestedProcDesc[bti]; Outer => P5U.Out1[qDESCB, body.entryIndex]; ENDCASE; END; PushNestedProcDesc: PUBLIC PROC [bti: CBTIndex] = BEGIN -- pushes a descriptor for nested local procedure on stack WITH body: bb[bti] SELECT FROM Inner => BEGIN avar: VarComponent = [ wSize: 1, space: faddr[wd: body.frameOffset, level: body.level-1]]; P5L.LoadComponent[avar]; END; ENDCASE END; SignalInit: PROC [node: Tree.Index] RETURNS [Lexeme] = BEGIN P5U.Out1[qDESCB, tb[node].info]; -- no sense making a VarItem to push RETURN [P5L.TOSLex[1]] END; END. NExpression.mesa last modified by Sweet, September 18, 1980 7:53 PM last modified by Satterthwaite, June 27, 1983 3:41 pm Last Edited by: Maxwell, August 11, 1983 9:12 am imported definitions relocs need not apply relocs get converted to addr generate code for "exp.field" if we point to a type, it fills a number of full words ʘ˜Jšœ™Jšœ3™3Jšœ5™5J™0J˜šÏk ˜ Jšœœœ ˜Jšœœœ˜!Jšœ œœ˜šœœœ˜J˜M—šœ œœ˜J˜AJ˜—Jšœ œœ˜*šœ œœ˜J˜GJ˜AJ˜Q—Jšœ œœ˜-Jšœ œœ ˜#Jšœœœ˜-šœœœ˜J˜>J˜GJ˜+—šœœœ˜J˜GJ˜AJ˜FJ˜ —šœœœ˜J˜QJ˜Q—šœœœ˜J˜4J˜=—Jšœ œœ˜-Jš œœœœœ˜-Jšœœ œ˜8Jšœœœ˜"Jšœ œœ:˜Ošœ œœ˜J˜=J˜/—Jšœœœ%˜5Jšœ œœ"˜5J˜—šœ ˜šœ˜"JšœN˜N—Jšœ˜Jš˜Jšœ˜J˜Jšœ™J˜Jšœ œ˜*Jšœœ˜5Jšœ œ˜%Jšœ œ˜'J˜Jšœ,œœ˜>J˜Jšœ œ˜&Jšœ œ˜"J˜$Jšœœ˜*Jšœ œ˜"Jšœœ˜,Jšœ œ˜"J˜Jšœ œ˜!J˜J˜JšœÏc˜)Jšœž#˜7Jšœž˜2Jšœž˜-Jšœž˜1J˜šœœ˜)Jšœž6˜=J˜J˜J˜J˜J˜Jšœ˜J˜—Jšœ œ ž˜-J˜šÏnœœœœ˜5Jšœž#˜)J˜šœœ˜˜ šœ œ˜Jšœœ˜,Jšœ œ ˜0Jšœ˜——Jšœ œ˜'˜ Jš˜J˜šœ˜Jšœœœ˜.š˜Jš˜šœ˜J˜J˜*Jšœ œ˜-Jšœœ˜—Jšœ˜Jšœ˜——J˜šœ˜Jšœ"œ˜(Jšœ"œ˜(J˜#J˜%J˜J˜J˜J˜J˜J˜'J˜J˜J˜J˜J˜J˜J˜J˜&J˜ Jšœ˜—J˜5J˜J˜#J˜!J˜*J˜!J˜ J˜J˜%J˜!J˜J˜J˜J˜#J˜J˜J˜J˜!˜Jš˜Jšœœ(˜4J˜4J˜J˜Jšœ˜—J˜%˜Jš˜Jšœœ"˜/J˜2J˜%J˜ Jšœ˜—J˜0J˜&Jšœ˜ —Jšœ˜—Jšœ˜—Jš˜Jšœ˜J˜J˜—š Ÿ œœœœœ˜;Jšœž/˜5šœ˜Jšœœ˜&—Jšœœœ˜Jšœ˜J˜—šŸœœœ ˜0Jšœž˜J˜ J˜ J˜šœœ˜˜Jšœœœ#˜>—J˜'Jšœ˜—J˜0J˜0Jšœœ˜J˜ Jšœ˜Jšœ˜J˜J˜—šŸœœœ ˜1Jšœž˜%J˜ J˜ šœœ˜˜Jšœœœ#˜>—J˜'Jšœ˜—Jšœœ˜*J˜J˜J˜ Jšœ˜Jšœ˜J˜J˜—šŸœœœ ˜2Jšœž˜$J˜ Jšœœ˜Jš œœœœœ˜6šœ˜#Jš˜J˜*J˜Jš˜—š˜Jš˜šœ˜Jš˜Jšœœœ˜2J˜%Jšœ˜—J˜ Jš œ œœœœœœ˜CJšœ˜—Jšœ˜Jšœ˜J˜J˜—šŸœœœ ˜1Jšœž˜J˜ J˜ J˜šœœ˜˜Jšœœœ#˜>—J˜5Jšœ˜—šœ˜˜šœ˜Jš˜Jšœ œ˜J˜J˜2šœ œ˜ šœœ˜&Jš˜J˜J˜-Jšœ˜Jšœ˜——Jšœ˜——Jšœ˜—J˜0J˜0Jšœœ˜J˜ Jšœ˜Jšœ˜J˜J˜—š Ÿœœœœœ ˜1Jšœœ˜J˜Jšœœœœ˜ Jšœœ˜ Jš œœ œœœ˜-šœœ ˜Jš œœ œœœ ˜-Jšœœ˜Jšœ˜—Jšœž2˜9Jšœ˜J˜J˜—šŸœœœœ˜0Jš˜Jšœ œœ˜*Jšœœ œ˜=Jšœ˜J˜—šŸœœœ ˜/Jšœž˜Jšœœ˜J˜ J˜ šœœ˜˜Jšœœœ#˜>—˜Jšœœœœ ˜>—Jšœœœœ˜9—Jšœœ˜*J˜šœ˜˜Jš˜Jšœ œ˜Jšœ œ˜J˜5šœ œ˜!Jš˜Jšœ œ˜J˜J˜#šœ ˜Jš˜J˜)Jšœ˜Jšœ˜—Jšœ˜—Jšœ˜—˜šœ˜Jš˜Jšœ œ˜J˜J˜2šœ œ˜ šœœ˜&Jš˜J˜.Jšœ˜Jšœ˜——Jšœ˜——Jšœ˜—J˜J˜ Jšœ˜Jšœ˜J˜J˜—šŸœœœ ˜/Jšœž˜Jšœœ˜Jšœœ œ˜'Jšœœ˜Jšœœ˜Jšœ œ˜šœœ˜Jšœ˜Jšœœœ˜,J˜ Jšœ˜—J˜šœ œ ˜Jš˜J˜5šœ œ˜!Jš˜J˜šœ ˜Jš˜J˜+Jšœ˜Jšœ˜—Jšœ˜—Jšœ˜—J˜šœ˜Jšœ˜Jšœ œœœ ˜+Jšœ˜Jšœ˜—Jšœ œœœ˜)J˜J˜J˜Jšœ˜Jšœ˜J˜—šŸœœœ(œ˜RJšœžF˜MJšœœœ˜*š˜Jš˜J˜&J˜ Jšœ œœ˜J˜ Jšœœ2˜Mšœœœ œ ˜7Jšœ˜Jšœ˜—Jšœ˜—Jšœ˜J˜J˜—šŸœœœ ˜1Jš˜Jšœœ˜(J˜J˜Jšœ˜Jšœ˜J˜—šŸœœœ ˜1Jš˜J˜>Jšœ6˜