-- Expression.mesa, modified by Sweet, January 11, 1980 11:59 AM DIRECTORY AltoDefs: FROM "altodefs" USING [BYTE, BytesPerWord, wordlength], Code: FROM "code" USING [ caseCVState, CodeNotImplemented, dStar, mwCaseCV, xtracting, xtractlex], CodeDefs: FROM "codedefs" USING [Lexeme, VarComponent, VarIndex], ControlDefs: FROM "controldefs" USING [ ControlLink, EPRange, GFTNull, ProcDesc, SignalDesc], FOpCodes: FROM "fopcodes" USING [ qADD, qAND, qBNDCK, qDADD, qDDIV, qDESCB, qDESCBS, qDIV, qDMOD, qDMUL, qDSUB, qDUDIV, qDUMOD, qEXCH, qFADD, qFDIV, qFLOAT, qFMUL, qFSUB, qLI, qMUL, qNEG, qNILCK, qNILCKL, qPOP, qPUSH, qSDIV, qSHIFT, qSUB], InlineDefs: FROM "inlinedefs" USING [BITAND, BITSHIFT], Literals: FROM "literals" USING [LTIndex, ltType, MSTIndex, stType], OpCodeParams: FROM "opcodeparams" USING [GlobalHB, LocalHB], P5: FROM "p5" USING [ AllExp, CaseStmtExp, ConstructExp, FlowExp, GenTempLex, MoveToCodeWord, P5Error, RowConsExp, TTAssign, WriteCodeWord], P5L: FROM "p5l" USING [ AddrForVar, AdjustComponent, ComponentForLex, ComponentForSE, CopyLex, FieldOfVarOnly, GenVarItem, LoadBoth, LoadComponent, LoadVar, MakeComponent, OVarItem, TOSComponent, TOSLex, VarAlignment, VarForLex, Words], P5S: FROM "p5s" USING [ AssignExp, BodyInit, CallExp, DIndex, ErrExp, ForkExp, Index, JoinExp, New, PortInit, SeqIndex, SigExp, StartExp, StringInit, SubstExp, SysErrExp], P5U: FROM "p5u" USING [ OperandType, Out0, Out1, PushLitVal, TreeLiteral, TreeLiteralValue, WordsForOperand, WordsForSei], SDDefs: FROM "sddefs", Stack: FROM "stack" USING [Dump, Require], StringDefs: FROM "stringdefs" USING [StringHeaderSize], SymbolOps: FROM "symbolops" USING [ FnField, NormalType, UnderType, WordsForType, XferMode], Symbols: FROM "symbols" USING [ BitAddress, bodyType, BTIndex, BTNull, CBTIndex, ContextLevel, CSEIndex, CTXIndex, ctxType, HTIndex, ISEIndex, lZ, RecordSEIndex, SEIndex, seType], Table: FROM "table" USING [Base, Notifier], Tree: FROM "tree" USING [Index, Link, Null, treeType]; Expression: PROGRAM IMPORTS CPtr: Code, InlineDefs, P5, P5L, P5S, P5U, Stack, SymbolOps EXPORTS CodeDefs, P5 SHARES Literals, StringDefs = BEGIN OPEN FOpCodes, CodeDefs; -- imported definitions BYTE: TYPE = AltoDefs.BYTE; wordlength: CARDINAL = AltoDefs.wordlength; BytesPerWord: CARDINAL = AltoDefs.BytesPerWord; StringHeaderSize: CARDINAL = StringDefs.StringHeaderSize; MSTIndex: TYPE = Literals.MSTIndex; LocalHB: TYPE = OpCodeParams.LocalHB; GlobalHB: TYPE = OpCodeParams.GlobalHB; BitAddress: TYPE = Symbols.BitAddress; BTIndex: TYPE = Symbols.BTIndex; CBTIndex: TYPE = Symbols.CBTIndex; BTNull: BTIndex = Symbols.BTNull; ContextLevel: TYPE = Symbols.ContextLevel; CSEIndex: TYPE = Symbols.CSEIndex; RecordSEIndex: TYPE = Symbols.RecordSEIndex; CTXIndex: TYPE = Symbols.CTXIndex; HTIndex: TYPE = Symbols.HTIndex; ISEIndex: TYPE = Symbols.ISEIndex; lZ: ContextLevel = Symbols.lZ; SEIndex: TYPE = Symbols.SEIndex; LTIndex: TYPE = Literals.LTIndex; tb: Table.Base; -- tree base (local copy) seb: Table.Base; -- semantic entry base (local copy) ctxb: Table.Base; -- context entry base (local copy) bb: Table.Base; -- body entry base (local copy) cb: Table.Base; -- code base (local copy) stb: Table.Base; -- string base (local copy) ltb: Table.Base; -- literal base (local copy) ExpressionNotify: PUBLIC Table.Notifier = BEGIN -- called by allocator whenever table area is repacked stb _ base[Literals.stType]; seb _ base[Symbols.seType]; ctxb _ base[Symbols.ctxType]; bb _ base[Symbols.bodyType]; cb _ tb _ base[Tree.treeType]; ltb _ base[Literals.ltType]; RETURN END; recentExp: PUBLIC Tree.Link; -- for debugging Exp: PUBLIC PROCEDURE [t: Tree.Link] RETURNS [l: Lexeme] = BEGIN -- generates code for an expression node: Tree.Index; WITH e: t SELECT FROM literal => WITH e.info SELECT FROM word => RETURN[Lexeme[literal[word[index]]]]; string => RETURN[Lexeme[literal[string[index]]]]; ENDCASE; symbol => BEGIN RETURN[Lexeme[se[e.index]]]; END; 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 => BEGIN l _ P5.CaseStmtExp[node, TRUE]; END; assignx => l _ P5S.AssignExp[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.ConstructExp[Tree.Null, node]; arraydesc => l _ ArrayDesc[node]; length => l _ Length[node]; base => l _ Base[node]; portinit => l _ P5S.PortInit[node]; body => l _ P5S.BodyInit[node]; rowcons => l _ P5.RowConsExp[Tree.Null, node]; stringinit => l _ P5S.StringInit[node]; pad => BEGIN psei: SEIndex = tb[node].info; tlex: se Lexeme = P5.GenTempLex[SymbolOps.WordsForType[psei]]; P5.TTAssign[[symbol[tlex.lexsei]], t]; l _ tlex; END; cast => l _ Exp[tb[node].son[1]]; 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 _ P5S.New[node]; mwconst => l _ MwConst[node]; signalinit => l _ SignalInit[node]; fork => l _ P5S.ForkExp[node]; joinx => l _ P5S.JoinExp[node]; float => l _ Float[node]; check => BEGIN PushRhs[tb[node].son[1]]; PushRhs[tb[node].son[2]]; P5U.Out0[FOpCodes.qBNDCK]; l _ P5L.TOSLex[1]; END; 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 => BEGIN l _ P5.AllExp[Tree.Null, node]; END; ENDCASE => l _ P5.FlowExp[node]; END; ENDCASE; RETURN END; ConstOperand: PROCEDURE [t: Tree.Link] RETURNS [BOOLEAN, 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: PROCEDURE [node: Tree.Index] RETURNS [Lexeme] = BEGIN -- generate code for + real: BOOLEAN = tb[node].attr1; double: BOOLEAN = real OR tb[node].attr2; op1, op2: VarComponent; IF double THEN BEGIN IF ~CPtr.dStar OR real THEN Stack.Dump[]; END; op1 _ P5L.ComponentForLex[Exp[tb[node].son[1]]]; op2 _ P5L.ComponentForLex[Exp[tb[node].son[2]]]; P5L.LoadBoth[@op1, @op2, TRUE]; IF double THEN BEGIN P5U.Out0[IF real THEN qFADD ELSE qDADD]; RETURN[P5L.TOSLex[2]] END; P5U.Out0[qADD]; RETURN[P5L.TOSLex[1]] END; Minus: PROCEDURE [node: Tree.Index] RETURNS [Lexeme] = BEGIN -- generate code for - real: BOOLEAN = tb[node].attr1; double: BOOLEAN = real OR tb[node].attr2; IF double THEN BEGIN IF ~CPtr.dStar OR real THEN Stack.Dump[]; END; PushRhs[tb[node].son[1]]; PushRhs[tb[node].son[2]]; IF double THEN BEGIN P5U.Out0[IF real THEN qFSUB ELSE qDSUB]; RETURN[P5L.TOSLex[2]] END; P5U.Out0[qSUB]; RETURN[P5L.TOSLex[1]] END; UMinus: PROCEDURE [node: Tree.Index] RETURNS [l: Lexeme] = BEGIN -- generate code for unary minus tt: Tree.Link _ tb[node].son[1]; real: BOOLEAN = tb[node].attr1; double: BOOLEAN = real OR tb[node].attr2; WITH tt SELECT FROM subtree => IF tb[index].name = uminus THEN BEGIN PushRhs[tb[index].son[1]]; RETURN END; ENDCASE; IF double THEN BEGIN IF ~CPtr.dStar OR real THEN Stack.Dump[]; P5U.PushLitVal[0]; P5U.PushLitVal[0]; IF real THEN P5U.Out0[qFLOAT]; END; PushRhs[tt]; IF double THEN P5U.Out0[IF real THEN qFSUB ELSE qDSUB] ELSE P5U.Out0[qNEG]; RETURN [P5L.TOSLex[IF double THEN 2 ELSE 1]]; END; Times: PROCEDURE [node: Tree.Index] RETURNS [Lexeme] = BEGIN -- generates code for multiply real: BOOLEAN = tb[node].attr1; double: BOOLEAN = real OR tb[node].attr2; op1, op2: VarComponent; IF double THEN Stack.Require[0]; op1 _ P5L.ComponentForLex[Exp[tb[node].son[1]]]; op2 _ P5L.ComponentForLex[Exp[tb[node].son[2]]]; P5L.LoadBoth[@op1, @op2, TRUE]; IF double THEN BEGIN P5U.Out0[IF real THEN qFMUL ELSE qDMUL]; RETURN[P5L.TOSLex[2]]; END; P5U.Out0[qMUL]; RETURN[P5L.TOSLex[1]] END; Log2: PROCEDURE [i: INTEGER] RETURNS [BOOLEAN, [0..16]] = BEGIN OPEN InlineDefs; 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; Div: PROCEDURE [node: Tree.Index] RETURNS [Lexeme] = BEGIN -- generate code for divide real: BOOLEAN = tb[node].attr1; double: BOOLEAN = real OR tb[node].attr2; signed: BOOLEAN = tb[node].attr3; rand2lit, powerof2: BOOLEAN; rand2val: INTEGER; shift: [0..16]; IF double THEN Stack.Require[0]; 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, shift] _ Log2[rand2val]; IF powerof2 THEN BEGIN P5U.PushLitVal[-shift]; P5U.Out0[qSHIFT]; RETURN [P5L.TOSLex[1]] END; END; END; PushRhs[tb[node].son[2]]; IF double THEN BEGIN P5U.Out0[IF real THEN qFDIV ELSE IF signed THEN qDDIV ELSE qDUDIV]; RETURN [P5L.TOSLex[2]]; END; IF signed THEN P5U.Out0[qSDIV] ELSE P5U.Out0[qDIV]; RETURN [P5L.TOSLex[1]]; END; Mod: PROCEDURE [node: Tree.Index] RETURNS [Lexeme] = BEGIN -- generate code for MOD real: BOOLEAN = tb[node].attr1; double: BOOLEAN = real OR tb[node].attr2; signed: BOOLEAN = tb[node].attr3; rand2lit, powerof2: BOOLEAN; 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; Float: PROCEDURE [node: Tree.Index] RETURNS [Lexeme] = BEGIN Stack.Dump[]; PushRhs[tb[node].son[1]]; P5U.Out0[qFLOAT]; RETURN[P5L.TOSLex[2]]; END; Addr: PROCEDURE [node: Tree.Index] RETURNS [Lexeme] = BEGIN -- generates code for "@" r: VarIndex; avar: VarComponent; r _ P5L.VarForLex[Exp[tb[node].son[1]]]; avar _ P5L.AddrForVar[r]; RETURN[[bdo[P5L.OVarItem[avar]]]] END; ArrayDesc: PROCEDURE [node: Tree.Index] RETURNS [Lexeme] = BEGIN -- pushes two components of an array descriptor onto stack size: CARDINAL; WITH tb[node].son[1] SELECT FROM subtree => BEGIN size _ SPushRhs[tb[index].son[1]]; size _ SPushRhs[tb[index].son[2]] + size; END; ENDCASE; RETURN[P5L.TOSLex[size]] END; Length: PROCEDURE [node: Tree.Index] RETURNS [Lexeme] = BEGIN -- generates code to extract length from array descriptor -- relocs need not apply 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: PROCEDURE [node: Tree.Index] RETURNS [Lexeme] = BEGIN -- generates code to extract base from array descriptor -- relocs get converted to addr 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: PROCEDURE [mainnode: Tree.Index] RETURNS [Lexeme] = BEGIN -- generate code for "exp.field" t1: Tree.Link _ tb[mainnode].son[1]; sei: ISEIndex; r: VarIndex; long: BOOLEAN = tb[mainnode].attr2; nilCheck: BOOLEAN = tb[mainnode].attr1; base: VarComponent; offset: VarComponent; -- fields of code data are dollar nodes IF tb[mainnode].name = uparrow THEN sei _ tb[mainnode].info ELSE WITH tb[mainnode].son[2] SELECT FROM symbol => sei _ index; ENDCASE; BEGIN -- to set up useBdo label IF nilCheck THEN BEGIN PushRhs[t1]; P5U.Out0[IF long THEN FOpCodes.qNILCKL ELSE FOpCodes.qNILCK]; base _ P5L.TOSComponent[IF long THEN 2 ELSE 1]; END ELSE WITH t1 SELECT FROM subtree => BEGIN stnode: Tree.Index = index; SELECT tb[stnode].name FROM plus => BEGIN disp: VarComponent; base _ P5L.ComponentForLex[Exp[tb[stnode].son[1]]]; disp _ P5L.ComponentForLex[Exp[tb[stnode].son[2]]]; r _ P5L.GenVarItem[bdo]; cb[r] _ [body: bdo[base: base, disp: disp, offset: NULL]]; GO TO useBdo; END; ENDCASE; END; ENDCASE; base _ P5L.ComponentForLex[Exp[t1]]; r _ P5L.GenVarItem[bo]; cb[r] _ [body: bo[base: base, offset: NULL]]; EXITS useBdo => NULL; END; IF tb[mainnode].name = uparrow THEN offset _ [wSize: P5U.WordsForSei[sei], space: frame[wd: 0]] ELSE IF seb[sei].constant THEN BEGIN -- procedure or signal from pointer to frame RETURN[ConstantField[@base, sei]] END ELSE BEGIN psei: CSEIndex = SymbolOps.NormalType[P5U.OperandType[tb[mainnode].son[1]]]; offset _ P5L.ComponentForSE[sei]; WITH offset SELECT FROM frame => level _ lZ; -- to take care of pointer to frame ENDCASE => ERROR; WITH seb[psei] SELECT FROM pointer => BEGIN OPEN SymbolOps; rcsei: CSEIndex _ UnderType[refType]; -- if we point to a type, it fills a number of full words 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; WITH cc: cb[r] SELECT FROM bo => cc.offset _ offset; bdo => cc.offset _ offset; ENDCASE => ERROR; RETURN[[bdo[r]]] END; Reloc: PUBLIC PROCEDURE [node: Tree.Index] RETURNS [Lexeme] = BEGIN -- generates code for "baseptr[relptr]" rd, rr: VarIndex; base, disp: VarComponent; base _ P5L.ComponentForLex[Exp[tb[node].son[1]]]; 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: PROCEDURE [ var: POINTER TO VarComponent, sei: ISEIndex] RETURNS [Lexeme] = BEGIN p: ControlDefs.ProcDesc; bti: CBTIndex; SELECT SymbolOps.XferMode[seb[sei].idType] FROM procedure => BEGIN IF seb[sei].extended THEN SIGNAL CPtr.CodeNotImplemented; bti _ seb[sei].idInfo; IF bti = BTNull THEN BEGIN RETURN [[bdo[ P5L.OVarItem[ [wSize: 1, space: const[d1: seb[sei].idValue]]]]]]; END; IF var.wSize > 1 THEN SIGNAL CPtr.CodeNotImplemented; P5L.LoadComponent[var^]; 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 => BEGIN OPEN ControlDefs; p.gfi _ entryIndex/EPRange; p.ep _ entryIndex MOD EPRange; p.tag _ procedure; P5U.Out1[qDESCBS, LOOPHOLE[p]]; END; ENDCASE; END; signal, error => BEGIN p _ seb[sei].idValue; p.gfi _ p.gfi-1; IF var.wSize > 1 THEN SIGNAL CPtr.CodeNotImplemented; P5L.LoadComponent[var^]; P5U.Out1[qDESCBS, LOOPHOLE[p]]; END; ENDCASE => P5.P5Error[643]; RETURN [P5L.TOSLex[1]]; END; Dollar: PROCEDURE [node: Tree.Index] RETURNS [Lexeme] = BEGIN -- generates code for "exp$field" sei: ISEIndex; r: VarIndex; recsei: RecordSEIndex _ LOOPHOLE[P5U.OperandType[tb[node].son[1]]]; functionCall: BOOLEAN; tBits, twSize: CARDINAL; tbSize: [0..wordlength); foffset: frame VarComponent; functionCall _ seb[recsei].argument; r _ P5L.VarForLex[Exp[tb[node].son[1]]]; [wSize: twSize, bSize: tbSize] _ P5L.VarAlignment[r, load]; tBits _ twSize*wordlength + tbSize; WITH tb[node].son[2] SELECT FROM symbol => BEGIN sei _ index; IF seb[sei].constant THEN BEGIN fpvar: VarComponent; WITH tb[node].son[1] SELECT FROM subtree => BEGIN node: Tree.Index = index; IF tb[node].name # uparrow THEN P5.P5Error[645]; fpvar _ P5L.ComponentForLex[Exp[tb[node].son[1]]]; END; ENDCASE => P5.P5Error[646]; RETURN [ConstantField[@fpvar, sei]]; END; 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]; RETURN [[bdo[r]]]; END; ENDCASE => ERROR; END; MwConst: PROCEDURE [node: Tree.Index] RETURNS [l: Lexeme] = BEGIN -- puts multi-word constant out to code stream lti: LTIndex; WITH tb[node].son[1] SELECT FROM literal => WITH info SELECT FROM word => lti _ index; ENDCASE => P5.P5Error[647]; ENDCASE => P5.P5Error[648]; 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; i: CARDINAL; IF ll.codeIndex = 0 THEN BEGIN ll.codeIndex _ P5.MoveToCodeWord[]; FOR i IN [0..nwords) DO P5.WriteCodeWord[ll.value[i]]; ENDLOOP; END; var _ [wSize: nwords, space: code[wd: ll.codeIndex]]; END; RETURN[[bdo[P5L.OVarItem[var]]]]; END; ENDCASE => ERROR; -- to keep the compiler happy END; DoubleZero: PUBLIC PROCEDURE [t: Tree.Link] RETURNS [BOOLEAN] = BEGIN node: Tree.Index; lti: LTIndex; WITH t SELECT FROM subtree => node _ index; ENDCASE => GO TO retFalse; IF tb[node].name # mwconst THEN GO TO retFalse; WITH tb[node].son[1] SELECT FROM literal => WITH info SELECT FROM word => lti _ index; ENDCASE => GO TO retFalse; ENDCASE => GO TO retFalse; WITH ll:ltb[lti] SELECT FROM long => SELECT ll.length FROM 2 => IF ll.value[0] = 0 AND ll.value[1] = 0 THEN RETURN[TRUE]; ENDCASE; ENDCASE; GO TO retFalse; EXITS retFalse => RETURN[FALSE]; END; LPushRhs: PUBLIC PROCEDURE [t: Tree.Link] RETURNS [Lexeme] = BEGIN -- forces a value onto the stack wSize: CARDINAL _ SPushRhs[t]; RETURN [P5L.TOSLex[wSize]]; END; PushRhs: PUBLIC PROCEDURE [t: Tree.Link] = BEGIN -- forces a value onto the stack [] _ SPushRhs[t]; RETURN END; SPushRhs: PROCEDURE [t: Tree.Link] RETURNS [wSize: CARDINAL] = BEGIN -- forces a value onto the stack RETURN[SPushLex[Exp[t]]]; END; SPushLex: PROCEDURE [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]; END; PushLex: PUBLIC PROCEDURE [l: Lexeme] = BEGIN [] _ SPushLex[l]; END; LPushLex: PUBLIC PROCEDURE [l: Lexeme] RETURNS [Lexeme] = BEGIN wSize: CARDINAL _ SPushLex[l]; RETURN [P5L.TOSLex[wSize]]; END; PushLProcDesc: PUBLIC PROCEDURE [bti: CBTIndex] = BEGIN -- pushes a descriptor for local procedure on stack WITH bb[bti] SELECT FROM Inner => PushNestedProcDesc[bti]; Outer => PushNonnestedProcDesc[entryIndex]; ENDCASE; RETURN END; PushNestedProcDesc: PUBLIC PROCEDURE [bti: CBTIndex] = BEGIN -- pushes a descriptor for nested local procedure on stack v: ContextLevel _ bb[bti].level - 1; WITH bb[bti] SELECT FROM Inner => BEGIN avar: VarComponent = [wSize: 1, space: faddr[wd: frameOffset, level: v]]; P5L.LoadComponent[avar]; RETURN END; ENDCASE END; PushNonnestedProcDesc: PUBLIC PROCEDURE [n: CARDINAL] = BEGIN -- pushes a descriptor for local procedure n on stack OPEN ControlDefs; p: ProcDesc; p.gfi _ n/EPRange; p.ep _ n MOD EPRange; p.tag _ procedure; P5U.Out1[qDESCB, LOOPHOLE[p]]; RETURN END; PushLSigDesc: PROCEDURE [desc: ControlDefs.SignalDesc] = BEGIN IF desc.gfi # ControlDefs.GFTNull THEN BEGIN desc.gfi _ desc.gfi-1; P5U.Out1[qDESCB, LOOPHOLE[desc]]; END ELSE P5U.PushLitVal[desc]; RETURN END; SignalInit: PROCEDURE [node: Tree.Index] RETURNS [Lexeme] = BEGIN OPEN ControlDefs; v: CARDINAL _ tb[node].info; P5U.Out1[qDESCB, LOOPHOLE[ControlLink[procedure[ gfi: v/EPRange, ep: v MOD EPRange, tag: procedure]]]]; RETURN [P5L.TOSLex[1]] END; END...