<> <> <> <> <> <> DIRECTORY Alloc, Basics, BcdDefs, Code, CodeDefs, ComData, ConvertUnsafe, FOpCodes, IntCodeDefs, IntCodeUtils, Literals, LiteralOps, OpCodeParams, P5, P5S, P5U, PrincOps, Real: FROM "IeeeFloat", Rope, SymbolOps, Symbols, Tree, TreeOps; Expression: PROGRAM IMPORTS CPtr: Code, MPtr: ComData, CodeDefs, ConvertUnsafe, IntCodeUtils, LiteralOps, P5, P5S, P5U, Real, SymbolOps, TreeOps EXPORTS CodeDefs, P5 SHARES Rope = BEGIN OPEN FOpCodes, CodeDefs, IntCodeDefs; <> FieldBitCount: TYPE = Symbols.FieldBitCount; WordCount: TYPE = Symbols.WordCount; BitCount: TYPE = Symbols.BitCount; 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; CTXIndex: TYPE = Symbols.CTXIndex; RecordSEIndex: TYPE = Symbols.RecordSEIndex; ISEIndex: TYPE = Symbols.ISEIndex; lZ: ContextLevel = Symbols.lZ; lG: ContextLevel = Symbols.lG; LTIndex: TYPE = Literals.LTIndex; CodeOper: TYPE = P5.CodeOper; 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) stb: Literals.Base; -- string 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]; stb _ base[Literals.stType]; END; recentExp: PUBLIC Tree.Link; -- for debugging ExpList: PUBLIC PROC [t: Tree.Link] RETURNS [head, tail: NodeList _ NIL] = { OneExp: Tree.Scan = { n: Node _ P5.Exp[t]; nl: NodeList _ P5U.MakeNodeList[n]; IF tail = NIL THEN head _ nl ELSE tail.rest _ nl; tail _ nl}; TreeOps.ScanList[t, OneExp]}; LitKindForType: PROC [type: Symbols.Type] RETURNS [RefLitKind] = { SELECT type FROM MPtr.typeATOM, MPtr.idATOM => RETURN[atom]; MPtr.idTEXT => RETURN[refText]; ENDCASE => RETURN[rope]; }; BitsForStringRep: PROC [string: LONG STRING] RETURNS [BitCount] = { chars: LONG CARDINAL _ string.length; RETURN[(chars+4)*CharSize]}; RopeHoldingStringRep: PROC [string: LONG STRING] RETURNS [ByteSequence] = { nchars: CARDINAL _ string.length; chars: Rope.Text _ z.NEW[Rope.TextRep[nchars + 4]]; lengthrep: RECORD[SELECT OVERLAID * FROM -- very host machine dependent bytes => [b: PACKED ARRAY [0..1] OF CHAR], card => [w: CARDINAL], ENDCASE] _ [card[nchars]]; chars[0] _ chars[2] _ lengthrep.b[0]; chars[1] _ chars[3] _ lengthrep.b[1]; FOR i: CARDINAL IN [0..nchars) DO chars[4+i] _ string[i]; ENDLOOP; RETURN[chars]}; Exp: PUBLIC PROC [t: Tree.Link] RETURNS [l: IntCodeDefs.Node] = BEGIN -- generates code for an expression node: Tree.Index; WITH e: t SELECT FROM literal => WITH e.index SELECT FROM word => RETURN [P5U.MakeNodeLiteral[LiteralOps.Value[lti]]]; string => { BEGIN msti: Literals.MSTIndex = LiteralOps.MasterString[sti]; string: LONG STRING _ @stb[msti].string; WITH s: stb[sti] SELECT FROM heap => RETURN[z.NEW[NodeRep.const.refLiteral _ [bits: PtrSize, details: const[data: refLiteral[ litKind: LitKindForType[s.type], contents: ConvertUnsafe.ToRope[string]]]]]]; ENDCASE => { body: Node _ z.NEW[NodeRep.const.bytes _ [ bits: BitsForStringRep[string], details: const[bytes[RopeHoldingStringRep[string]]]]]; RETURN[P5U.ApplyOp[oper: P5U.MesaOpNode[addr], args: P5U.MakeNodeList[body], bits: PtrSize]]; }; END; }; < RETURN [Lexeme[literal[string[sti]]]];>> ENDCASE; symbol => { sei: ISEIndex = e.index; IF ~seb[sei].constant THEN RETURN[VarForSei[e.index]]; SELECT SymbolOps.XferMode[seb[sei].idType] FROM proc => { -- get the label for the proc bti: CBTIndex = seb[sei].idInfo; op: CodeOper _ z.NEW[OperRep.code _ [code[label: NIL, offset: 0]]]; P5.FillProcLabel[op: op, bti: bti]; l _ z.NEW[NodeRep.oper _ [bits: ProcSize, details: oper[op]]]; RETURN[l]; }; signal, error => RETURN[NIL]; -- what to do here? program => RETURN[NIL]; -- what to do here? ENDCASE => ERROR; }; subtree => BEGIN recentExp _ t; IF e = Tree.Null THEN RETURN[IF CPtr.xtracting THEN CPtr.xtractNode ELSE CPtr.caseCV]; 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 = SymbolOps.UnderType[tb[node].info]; bits: BitCount _ P5U.FullWordBits[P5U.BitsForType[psei]]; cl: CodeList _ P5U.NewCodeList[]; tv: Var _ P5U.MakeTemp[cl: cl, bits: bits, init: P5.Exp[t]].var; P5U.MoreCode[cl, tv]; l _ P5U.MakeBlock[cl, bits]; 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]; listcons => l _ P5.ListCons[node]; create => l _ P5S.Create[node]; mwconst => l _ MwConst[node]; fork => l _ P5S.ForkExp[node]; joinx => l _ P5S.JoinExp[node]; float => l _ Float[node]; narrow => l _ P5.NarrowExp[node]; check => l _ P5U.BoundsCheck[Exp[tb[node].son[1]], Exp[tb[node].son[2]]]; proccheck => l _ P5S.ProcCheck[node]; chop => BEGIN bits: BitCount = P5U.BitsForType[tb[node].info]; l _ P5U.TakeField[n: Exp[tb[node].son[1]], vl: [disp: 0, size: bits]]; END; all => l _ P5.All[Tree.Null, node, ExprOptions]; gcrt => l _ P5.GetCanonicalType[node]; ENDCASE => l _ P5.FlowExp[node]; END; ENDCASE; RETURN END; VarForSei: PUBLIC PROC [sei: ISEIndex] RETURNS [l: Var] = { loc: Location; ctx: CTXIndex _ seb[sei].idCtx; level: ContextLevel _ SymbolOps.CtxLevel[ctx]; id: INT _ LONG[LOOPHOLE[sei, CARDINAL]]; SELECT level FROM lZ => ERROR; lG => loc _ z.NEW[globalVar LocationRep _ [globalVar[id: 0]]]; ENDCASE => loc _ z.NEW[localVar LocationRep _ [localVar[id: 0, parent: P5.visibleContext[level]]]]; l _ P5U.MakeVar[bits: LONG[LOOPHOLE[seb[sei].idInfo, CARDINAL]], id: id, loc: loc]; }; BinaryOp: PROC [node: Tree.Index, op: ArithSelector] RETURNS [l: Node] = BEGIN -- generate code for +, -, *, /, etc. op1, op2: Node; op1 _ Exp[tb[node].son[1]]; op2 _ Exp[tb[node].son[2]]; l _ P5U.ApplyOp[oper: P5U.ArithOpForTree[node, op], args: P5U.MakeNodeList2[op1, op2], bits: op1.bits]; END; Plus: PROC [node: Tree.Index] RETURNS [l: Node] = {RETURN[BinaryOp[node, add]]}; Minus: PROC [node: Tree.Index] RETURNS [l: Node] = {RETURN[BinaryOp[node, sub]]}; UMinus: PROC [node: Tree.Index] RETURNS [l: Node] = BEGIN -- generate code for (unary) - op1: Node; op1 _ Exp[tb[node].son[1]]; l _ P5U.ApplyOp[oper: P5U.ArithOpForTree[node, neg], args: P5U.MakeNodeList[op1], bits: op1.bits]; END; Times: PROC [node: Tree.Index] RETURNS [Node] = {RETURN[BinaryOp[node, mul]]}; Div: PROC [node: Tree.Index] RETURNS [Node] = {RETURN[BinaryOp[node, div]]}; Mod: PROC [node: Tree.Index] RETURNS [Node] = {RETURN[BinaryOp[node, mod]]}; Float: PROC [node: Tree.Index] RETURNS [l: Node] = BEGIN op1: Node; op1 _ Exp[tb[node].son[1]]; l _ P5U.ApplyOp[oper: P5U.ConvertOpNode[from: longSigned, to: shortReal], args: P5U.MakeNodeList[op1], bits: op1.bits]; END; Safen: PROC [node: Tree.Index] RETURNS [l: Node] = BEGIN cl: CodeList _ P5U.NewCodeList[]; nt: Tree.Link; nt _ P5U.ProcessSafens[cl, [subtree[node]]]; l _ Exp[nt]; RETURN[P5U.MaybeBlock[cl, l]]; END; Addr: PROC [node: Tree.Index] RETURNS [l: Node] = BEGIN -- generates code for "@" op1: Node = Exp[tb[node].son[1]]; l _ P5U.ApplyOp[oper: P5U.MesaOpNode[addr], args: P5U.MakeNodeList[op1], bits: PtrSize]; END; ArrayDesc: PROC [node: Tree.Index] RETURNS [l: Node] = BEGIN -- pushes two components of an array descriptor onto stack subNode: Tree.Index = TreeOps.GetNode[tb[node].son[1]]; <> base: Node _ Exp[tb[subNode].son[1]]; length: Node _ Exp[tb[subNode].son[2]]; loc: Location _ z.NEW[composite LocationRep _ [composite[P5U.MakeNodeList2[base, length]]]]; l _ z.NEW[var NodeRep _ [bits: 2*WordSize, details: var[location: loc]]]; END; Length: PROC [node: Tree.Index] RETURNS [l: Node] = BEGIN -- generates code to extract length from array descriptor <> ad: Node = Exp[tb[node].son[1]]; loc: Location _ z.NEW[field LocationRep _ [field[base: ad, start: WordSize]]]; l _ P5U.MakeVar[bits: WordSize, loc: loc]; END; Base: PROC [node: Tree.Index] RETURNS [l: Node] = BEGIN -- generates code to extract base from array descriptor <> ad: Node = Exp[tb[node].son[1]]; loc: Location _ z.NEW[field LocationRep _ [field[base: ad, start: 0]]]; l _ P5U.MakeVar[bits: PtrSize, loc: loc]; END; DerefLocation: TYPE = REF deref LocationRep; FieldLocation: TYPE = REF field LocationRep; DotOrUparrow: PROC [mainnode: Tree.Index] RETURNS [l: Node] = BEGIN <> t1: Tree.Link = tb[mainnode].son[1]; ptr: Node _ Exp[t1]; nilCheck: BOOL; derefLoc: DerefLocation _ z.NEW[deref LocationRep _ [deref[addr: ptr]]]; derefVar: Var _ P5U.MakeVar[bits: size, loc: derefLoc]; field: VLoc; size: FieldBitCount; end: WordCount; IF tb[mainnode].name = uparrow THEN BEGIN end _ P5U.WordsForSei[tb[mainnode].info]; size _ end*WordSize; l _ derefVar; l.bits _ size; END ELSE BEGIN sei: ISEIndex = TreeOps.GetSe[tb[mainnode].son[2]]; psei: CSEIndex = SymbolOps.NormalType[P5U.OperandType[t1]]; offset: BitAddress; size: FieldBitCount; [offset: offset, size: size] _ SymbolOps.RecField[sei]; end _ P5U.WordsForBits[P5U.Bits[offset]+size]; field _ [disp: P5U.Bits[offset], size: size]; WITH seb[psei] SELECT FROM ref => BEGIN OPEN SymbolOps; rcsei: CSEIndex = UnderType[refType]; <> WITH seb[rcsei] SELECT FROM record => field _ P5U.AdjustLoc[vl: field, rSei: LOOPHOLE[rcsei], fSei: sei, tBits: P5U.FullWordBits[P5U.BitsForType[rcsei]]]; ENDCASE; END; ENDCASE => P5.P5Error[642]; l _ P5U.TakeField[n: derefVar, vl: field]; END; IF tb[mainnode].attr1 THEN BEGIN -- nil checking, see if hardware will do it tsei: CSEIndex = SymbolOps.UnderType[tb[mainnode].info]; nilCheck _ ~MPtr.switches['a] OR end > 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; IF nilCheck THEN { nc: Node = P5U.ApplyOp[oper: P5U.MesaOpNode[nilck], args: P5U.MakeNodeList[ptr], bits: PtrSize]; derefLoc.addr _ nc}; 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 [l: Node] = BEGIN -- generates code for "baseptr[relptr]" base: Node _ Exp[tb[node].son[1]]; relptr: Node _ Exp[tb[node].son[2]]; sum: Node; IF tb[node].attr1 THEN BEGIN -- reloc of an array descriptor field: FieldLocation _ z.NEW[field LocationRep _ [field[base: relptr, start: 0]]]; relptr _ P5U.MakeVar[bits: PtrSize, loc: field]; END; sum _ P5U.ApplyOp[oper: P5U.ArithOpForTree[node, add], args: P5U.MakeNodeList2[base, relptr], bits: PtrSize]; l _ P5U.Deref[n: sum, bits: SymbolOps.WordsForType[tb[node].info]*WordSize]; END; Dollar: PROC [node: Tree.Index] RETURNS [l: Node] = BEGIN -- generates code for "exp$field" sei: ISEIndex = TreeOps.GetSe[tb[node].son[2]]; rec: Node; field: FieldLocation_ NIL; rcsei: RecordSEIndex = LOOPHOLE[P5U.OperandType[tb[node].son[1]]]; functionCall: BOOL = seb[rcsei].argument; offset: BitAddress; size: FieldBitCount; vl: VLoc; rec _ Exp[tb[node].son[1]]; IF functionCall THEN [offset, size] _ SymbolOps.FnField[sei] ELSE [offset, size] _ SymbolOps.RecField[sei]; vl _ [disp: P5U.Bits[offset], size: size]; IF rec.bits < WordSize THEN vl _ P5U.AdjustLoc[vl: vl, rSei: rcsei, fSei: sei, tBits: rec.bits]; l _ P5U.TakeField[n: rec, vl: vl]; END; MwConst: PROC [node: Tree.Index] RETURNS [l: Node] = 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 => l _ P5U.MakeNodeLiteral[LiteralOps.Value[lti]]; long => BEGIN SELECT ll.length FROM 0 => P5.P5Error[649]; 1 => l _ P5U.MakeNodeLiteral[ll.value[0]]; 2 => { idw: RECORD [SELECT OVERLAID * FROM twoWords => [v1, v2: WORD], int => [i: INT], ENDCASE]; idw.v1 _ ll.value[0]; idw.v2 _ ll.value[1]; l _ P5U.MakeNodeLiteral[idw.i]}; ENDCASE => l _ NIL; -- REMOVE <> <> <> <> <> <> <> <> <> <> 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; END.