-- file Pass4Xb.mesa
-- last written by Satterthwaite, September 17, 1982 4:15 pm

DIRECTORY
  Alloc: TYPE USING [Notifier],
  ComData: TYPE USING [
    definitionsOnly, switches, typeCARDINAL, typeINT, typeSTRING, zone],
  Heap: TYPE USING [FreeNode, MakeNode],
  LiteralOps: TYPE USING [
    MasterString, ValueDescriptor, FindDescriptor, FindLocalString, StringReference],
  Log: TYPE USING [ErrorTree, WarningTree],
  P4: TYPE USING [
    Repr, none, signed, unsigned, both, long, other, RegCount, MaxRegs,
    checked, currentLevel,
    AddrOp, All, Assignment, BiasForType, BindCase, BindType, BoolValue, Call,
    CanonicalType, CaseDriver, CatchNest, CheckRange, CommonRep, ComparableType,
    ConstantInterval, Construct, DeclItem, Dollar, EmptyInterval, Extract,
    FoldExpr, Index, Interval, IntToReal, LiteralRep, LongToShort,
    MakeTreeLiteral, MarkString, MiscXfer, Narrow, New, NormalizeRange,
    PadRecord, Reloc, RepForType, Rhs, RowConstruct, SeqIndex, ShortToLong,
    Subst, TreeLiteralValue, TypeExp, TypeOp, Union, WordsForType],
  Pass4: TYPE USING [implicitBias, implicitRep, implicitType, tFALSE, tTRUE],
  Symbols: TYPE USING [
    Base, SEIndex, ISEIndex, CSEIndex, lG, typeANY, seType],
  SymbolOps: TYPE USING [
    Cardinality, ConstantId, FindExtension, NormalType, RCType, TypeForm,
    UnderType, WordsForType, XferMode],
  SymLiteralOps: TYPE USING [AtomRef, TextRef],
  Tree: TYPE USING [Base, Index, Link, Map, NodeName, Null, treeType],
  TreeOps: TYPE USING [
    FreeNode, GetHash, GetNode, IdentityMap, ListLength, OpName, PopTree,
    PushLit, PushNode, PushTree, SetAttr, SetInfo, SetShared, Shared, UpdateList];

Pass4Xb: PROGRAM
    IMPORTS
      Heap, Log, LiteralOps, P4, SymbolOps, SymLiteralOps, TreeOps,
      dataPtr: ComData, passPtr: Pass4
    EXPORTS P4 = {
  OPEN SymbolOps, P4, TreeOps;

 -- pervasive definitions from Symbols

  ISEIndex: TYPE = Symbols.ISEIndex;
  CSEIndex: TYPE = Symbols.CSEIndex;


  tb: Tree.Base;	-- tree base address (local copy)
  seb: Symbols.Base;	-- se table base address (local copy)

  zone: UNCOUNTED ZONE _ NIL;
  
  ExpBNotify: PUBLIC Alloc.Notifier = {
    -- called by allocator whenever table area is repacked
    tb _ base[Tree.treeType]; seb _ base[Symbols.seType]};


 -- intermediate result bookkeeping

  ValueDescriptor: TYPE = RECORD[
    bias: INTEGER,		-- bias in representation (scalars only)
    nRegs: RegCount,		-- estimate of register requirement
    rep: Repr];			-- signed/unsigned (scalars only)

  VStack: TYPE = RECORD [SEQUENCE length: NAT OF ValueDescriptor];
  vStack: LONG POINTER TO VStack _ NIL;
  vI: INTEGER;			-- index into vStack

  VPush: PUBLIC PROC [bias: INTEGER, rep: Repr, nRegs: RegCount] = {
    vI _ vI + 1;
    WHILE vI >= vStack.length DO
      newLength: NAT = vStack.length + 16;
      newStack: LONG POINTER TO VStack = zone.NEW[VStack[newLength]];
      FOR i: INTEGER IN [0 .. vI) DO newStack[i] _ vStack[i] ENDLOOP;
      zone.FREE[@vStack];
      vStack _ newStack;
      ENDLOOP;
    vStack[vI] _ [bias:bias, rep:rep, nRegs:nRegs]};

  VPop: PUBLIC PROC = {IF vI < 0 THEN ERROR; vI _ vI-1};

  VBias: PUBLIC PROC RETURNS [INTEGER] = {RETURN [vStack[vI].bias]};

  VRep: PUBLIC PROC RETURNS [Repr] = {RETURN [vStack[vI].rep]};

  VRegs: PUBLIC PROC RETURNS [RegCount] = {RETURN [vStack[vI].nRegs]};


  ExpInit: PUBLIC PROC [scratchZone: UNCOUNTED ZONE] = {
    zone _ scratchZone;
    vStack _ zone.NEW[VStack[32]];
    vI _ -1};

  ExpReset: PUBLIC PROC = {
    IF vStack # NIL THEN zone.FREE[@vStack];
    zone _ NIL};


  OperandType: PUBLIC PROC [t: Tree.Link] RETURNS [CSEIndex] = {
    RETURN [WITH t SELECT FROM
      symbol => UnderType[seb[index].idType],
      literal => IF info.litTag = string THEN dataPtr.typeSTRING ELSE dataPtr.typeINT,
      subtree => IF t = Tree.Null THEN passPtr.implicitType ELSE tb[index].info,
      ENDCASE => Symbols.typeANY]};

  ForceType: PUBLIC PROC [t: Tree.Link, type: CSEIndex] RETURNS [Tree.Link] = {
    PushTree[t];
    IF (OpName[t] # mwconst AND OpName[t] # cast) OR Shared[t] THEN PushNode[cast, 1];
    SetInfo[type];  RETURN [PopTree[]]};

  ChopType: PROC [t: Tree.Link, type: CSEIndex] RETURNS [Tree.Link] = {
    PushTree[t]; PushNode[chop, 1]; SetInfo[type]; RETURN [PopTree[]]};


 -- literals

  TreeLiteral: PUBLIC PROC [t: Tree.Link] RETURNS [BOOLEAN] = {
    RETURN [WITH t SELECT FROM
      literal => info.litTag = word,
      subtree =>
	SELECT tb[index].name FROM
	  cast => TreeLiteral[tb[index].son[1]],
	  ENDCASE => FALSE,
      ENDCASE => FALSE]};

  StructuredLiteral: PUBLIC PROC [t: Tree.Link] RETURNS [BOOLEAN] = {
    RETURN [WITH t SELECT FROM
      literal => info.litTag = word,
      subtree =>
	SELECT tb[index].name FROM
	  mwconst => TRUE,
	  cast => StructuredLiteral[tb[index].son[1]],
	  ENDCASE => FALSE,
      ENDCASE => FALSE]};

  MakeStructuredLiteral: PUBLIC PROC [val: WORD, type: CSEIndex]
      RETURNS [t: Tree.Link] = {
    t _ MakeTreeLiteral[val];
    SELECT seb[type].typeTag FROM
      basic, enumerated, subrange, mode => NULL;
      ENDCASE => t _ ForceType[t, type];
    RETURN};


 -- register accounting

  RegsForType: PUBLIC PROC [type: CSEIndex] RETURNS [RegCount] = {
    n: RegCount = IF seb[type].mark4 THEN SymbolOps.WordsForType[type] ELSE 0;
    RETURN [IF n = 2 THEN 2 ELSE 1]};

  ComputeRegs: PROC [node: Tree.Index] RETURNS [RegCount] = {
    n1: RegCount = vStack[vI-1].nRegs;
    n2: RegCount = vStack[vI].nRegs;
    k: RegCount = RegsForType[tb[node].info];
    RETURN [MIN[MAX[n1, n2+k], MaxRegs]]};

  ComputeIndexRegs: PUBLIC PROC [node: Tree.Index] RETURNS [RegCount] = {
    n1: RegCount = vStack[vI-1].nRegs;
    n2: RegCount = vStack[vI].nRegs;
    k: RegCount = RegsForType[OperandType[tb[node].son[1]]];
    RETURN [MIN[MAX[RegsForType[tb[node].info], n1, n2+k], MaxRegs]]};

  AdjustRegs: PROC [node: Tree.Index, commuteOp: Tree.NodeName]
      RETURNS [RegCount] = {
    n1: RegCount = vStack[vI-1].nRegs;
    n2: RegCount = vStack[vI].nRegs;
    k: RegCount = RegsForType[tb[node].info];
    n: CARDINAL;
    IF n1 >= n2 THEN n _ n2 + k
    ELSE {
      v: ValueDescriptor;
      t: Tree.Link _ tb[node].son[1];
      tb[node].son[1] _ tb[node].son[2]; tb[node].son[2] _ t;
      tb[node].name _ commuteOp;
      v _ vStack[vI]; vStack[vI] _ vStack[vI-1]; vStack[vI-1] _ v;
      n _ n1 + k};
    RETURN [MIN[MAX[n1, n2, n], MaxRegs]]};


 -- operators

  Fold: PROC [node: Tree.Index, rep: Repr] RETURNS [Tree.Link] = {
    fullRep: Repr = IF tb[node].attr2 THEN long + rep ELSE rep;
    RETURN [FoldExpr[node, fullRep]]};


  Substx: PROC [node: Tree.Index] RETURNS [val: Tree.Link] = {
    type: CSEIndex = tb[node].info;
    subNode: Tree.Index;
    val _ Subst[node];  node _ GetNode[val];
    IF OpName[tb[node].son[2]] = result THEN {
      subNode _ GetNode[tb[node].son[2]];
      SELECT ListLength[tb[subNode].son[1]] FROM
	0 => ERROR;
	1 => {
	  tb[subNode].son[1] _ Unsafen[tb[subNode].son[1]];
	  val _ IF tb[subNode].attr3
	    THEN tb[subNode].son[1]
	    ELSE ForceType[tb[subNode].son[1], type]};
	ENDCASE => {
	  PushTree[Tree.Null];  PushTree[tb[subNode].son[1]];
	  PushNode[construct, 2];  SetInfo[type];  val _ PopTree[]};
      tb[subNode].son[1] _ Tree.Null;  FreeNode[node]};
    VPush[BiasForType[type], RepForType[type], MaxRegs];
    RETURN};

  Unsafen: Tree.Map = {
    IF OpName[t] = safen THEN {
      node: Tree.Index = GetNode[t];
      v _ tb[node].son[1];  tb[node].son[1] _ Tree.Null; FreeNode[node]}
    ELSE v _ t;
    RETURN};


  UMinus: PROC [node: Tree.Index] RETURNS [val: Tree.Link] = {
    tb[node].son[1] _ Exp[tb[node].son[1], signed];
    SELECT vStack[vI].rep FROM
      both => vStack[vI].rep _ signed;
      none => {Log.WarningTree[mixedRepresentation, val]; vStack[vI].rep _ signed};
      ENDCASE => NULL;
    IF ~StructuredLiteral[tb[node].son[1]] THEN {
      tb[node].attr3 _ TRUE; val _ [subtree[index: node]]}
    ELSE val _ Fold[node, vStack[vI].rep];
    IF vStack[vI].rep = unsigned THEN vStack[vI].rep _ signed;
    vStack[vI].bias _ -VBias[];
    RETURN};

  Abs: PROC [node: Tree.Index] RETURNS [val: Tree.Link] = {
    rep: Repr;
    tb[node].son[1] _ RValue[tb[node].son[1], 0, signed];
    val _ [subtree[index: node]];  rep _ vStack[vI].rep;
    SELECT rep FROM
      unsigned, both => {
	Log.WarningTree[unsignedCompare, val];
	val _ tb[node].son[1];  tb[node].son[1] _ Tree.Null;  FreeNode[node]};
      none => {Log.ErrorTree[mixedRepresentation, val]; vStack[vI].rep _ both};
      ENDCASE => {
	tb[node].attr3 _ TRUE;
	IF StructuredLiteral[tb[node].son[1]] THEN val _ Fold[node, rep];
	IF rep # other THEN vStack[vI].rep _ both};
    RETURN};


  EnumOp: PROC [node: Tree.Index, target: Repr] RETURNS [Tree.Link] = {
    t: Tree.Link;
    type: CSEIndex = tb[node].info;
    nType: CSEIndex = NormalType[type];
    long: BOOLEAN = seb[type].typeTag = long;
    d: INTEGER _ 0;
    DO
      d _ IF tb[node].name = pred THEN d-1 ELSE d+1;
      t _ tb[node].son[1];  tb[node].son[1] _ Tree.Null; FreeNode[node];
      SELECT OpName[t] FROM
	pred, succ => NULL;
	ENDCASE => EXIT;
      node _ GetNode[t];
      ENDLOOP;
    PushTree[t];  PushTree[MakeTreeLiteral[ABS[d]]];
    IF long THEN {PushNode[lengthen, 1]; SetInfo[type]};
    PushNode[IF d < 0 THEN minus ELSE plus, 2];
    SetInfo[type]; SetAttr[1, FALSE]; SetAttr[2, long];
    RETURN [IF seb[nType].typeTag = enumerated
      THEN CheckRange[
	RValue[PopTree[], BiasForType[nType], target], Cardinality[nType], nType]
      ELSE AddOp[GetNode[PopTree[]], target]]};


  ArithRep: PROC [rep, target: Repr] RETURNS [Repr] = {
    RETURN [SELECT rep FROM
      both, none =>
        SELECT target FROM both, none, other => signed, ENDCASE => target,
      ENDCASE => rep]};
      
  BiasedFold: PROC [node: Tree.Index, rep: Repr] RETURNS [Tree.Link] = {
    fullRep: Repr = IF tb[node].attr2 THEN long + rep ELSE rep;
    tb[node].son[1] _ AdjustBias[tb[node].son[1], -vStack[vI-1].bias];
    tb[node].son[2] _ AdjustBias[tb[node].son[2], -vStack[vI].bias];
    RETURN [FoldExpr[node, fullRep]]};

  AddOp: PROC [node: Tree.Index, target: Repr] RETURNS [val: Tree.Link] = {
    OPEN tb[node];
    op: Tree.NodeName = tb[node].name;
    type: CSEIndex = tb[node].info;
    bias, shift: INTEGER;
    rep: Repr;
    nRegs: RegCount;
    son[1] _ Exp[son[1], target];  son[2] _ Exp[son[2], target];
    val _ [subtree[index: node]]; 
    rep _ CommonRep[vStack[vI-1].rep, vStack[vI].rep];
    SELECT rep FROM
      both => rep _ ArithRep[rep, target];
      none =>
	IF target = none THEN {Log.WarningTree[mixedRepresentation, val]; rep _ both}
	ELSE rep _ IF target = both THEN signed ELSE target;
      ENDCASE => NULL;
    IF StructuredLiteral[son[1]] AND StructuredLiteral[son[2]] AND ~attr1 THEN {
      val _ BiasedFold[node, rep];
      rep _ LiteralRep[val, rep];  bias _ 0;  nRegs _ RegsForType[type]}
    ELSE {
      nRegs _ IF op=plus THEN AdjustRegs[node, plus] ELSE ComputeRegs[node];
      bias _ vStack[vI-1].bias;  shift _ vStack[vI].bias;
      attr3 _ rep # unsigned;
      SELECT TRUE FROM
	TreeLiteral[son[2]] => {
	  val _ son[1];  shift _ shift + TreeLiteralValue[son[2]];
	  son[1] _ Tree.Null;  FreeNode[node]};
	(op = plus AND TreeLiteral[son[1]]) => {
	  val _ son[2];  shift _ shift + TreeLiteralValue[son[1]];
	  son[2] _ Tree.Null;  FreeNode[node]};
	ENDCASE;
      bias _ bias + (IF op=plus THEN shift ELSE -shift)};
    VPop[];  VPop[];  VPush[bias, rep, nRegs];
    IF type # dataPtr.typeINT AND OperandType[val] # type THEN val _ ForceType[val, type];
    RETURN};

  Mult: PROC [node: Tree.Index, target: Repr] RETURNS [val: Tree.Link] = {
    OPEN tb[node];
    rep: Repr;
    const1, const2: BOOLEAN;
    v1, v2: WORD;
    bias: INTEGER;
    nRegs: RegCount;
    t: Tree.Link;
    son[1] _ Exp[son[1], target];  son[2] _ Exp[son[2], target];
    val _ [subtree[index: node]];
    rep _ CommonRep[vStack[vI-1].rep, vStack[vI].rep];
    SELECT rep FROM
      both => rep _ ArithRep[rep, target];
      none =>
	IF target = none THEN {Log.WarningTree[mixedRepresentation, val]; rep _ both}
	ELSE rep _ IF target = both THEN signed ELSE target;
      ENDCASE => NULL;
    IF StructuredLiteral[son[1]] AND StructuredLiteral[son[2]] AND ~attr1 THEN {
      nRegs _ RegsForType[info];
      val _ BiasedFold[node, rep];  rep _ LiteralRep[val, rep];  bias _ 0}
    ELSE {
      nRegs _ AdjustRegs[node, times];
      const1 _ TreeLiteral[son[1]];  const2 _ TreeLiteral[son[2]];
      IF const1 OR ~const2 THEN son[1] _ AdjustBias[son[1], -vStack[vI-1].bias];
      IF ~const1 OR const2 THEN son[2] _ AdjustBias[son[2], -vStack[vI].bias];
      IF const1 THEN v1 _ TreeLiteralValue[son[1]];
      IF const2 THEN v2 _ TreeLiteralValue[son[2]];
      attr3 _ rep # unsigned;
      bias _ SELECT TRUE FROM
	const1 => v1*vStack[vI].bias,
	const2 => vStack[vI-1].bias*v2,
	ENDCASE => 0;
      IF StructuredLiteral[son[1]] -- AND ~const2 -- THEN {
        t _ son[2]; son[2] _ son[1]; son[1] _ t};
      IF const1 OR const2 THEN
	SELECT (IF const1 THEN v1 ELSE v2) FROM
	  0 => {val _ son[2]; son[2] _ Tree.Null; FreeNode[node]; rep _ both};
	  1 => {
	    val _ son[1];  son[1] _ Tree.Null;  FreeNode[node];
	    rep _ vStack[IF const1 THEN vI ELSE vI-1].rep};
	  -1 => {
	    PushTree[son[1]];  son[1] _ Tree.Null;  FreeNode[node];
	    PushNode[uminus, 1];  SetInfo[dataPtr.typeINT];
	    SetAttr[1, FALSE]; SetAttr[2, FALSE]; SetAttr[3, TRUE];
	    val _ PopTree[]};
	  ENDCASE};
    VPop[];  VPop[];  VPush[bias, rep, nRegs];
    RETURN};

  DivMod: PROC [node: Tree.Index, target: Repr] RETURNS [val: Tree.Link] = {
    OPEN tb[node];
    rep: Repr;
    nRegs: RegCount;
    son[1] _ RValue[son[1], 0, target];  son[2] _ RValue[son[2], 0, target];
    val _ [subtree[index: node]];
    rep _ CommonRep[vStack[vI-1].rep, vStack[vI].rep];
    SELECT rep FROM
      both => NULL;	-- preserved by div and mod
      none =>
	IF target = none THEN {Log.ErrorTree[mixedRepresentation, val]; rep _ both}
	ELSE rep _ target;
      ENDCASE => NULL;
    IF StructuredLiteral[son[1]] AND StructuredLiteral[son[2]] AND ~attr1 THEN {
      nRegs _ RegsForType[info]; val _ Fold[node, rep]; rep _ LiteralRep[val, rep]}
    ELSE {
      nRegs _ ComputeRegs[node];
      attr3 _ CommonRep[rep, unsigned] = none;
      IF name = div AND TreeLiteral[son[2]] THEN
	SELECT TreeLiteralValue[son[2]] FROM
	  = 1 => {val _ son[1]; son[1] _ Tree.Null; FreeNode[node]};
	  >=2 => IF rep = unsigned THEN rep _ both;
	  ENDCASE};
    VPop[];  VPop[];  VPush[0, rep, nRegs];  RETURN};


  RelOp: PROC [node: Tree.Index] RETURNS [val: Tree.Link] = {
    OPEN tb[node];
    rep, rep1, rep2: Repr;
    nRegs: RegCount;
    d1, d2: INTEGER;
    uc: BOOLEAN;
    ZeroWarning: ARRAY Tree.NodeName [relE..relLE] OF [0..2] = [0, 0, 2, 2, 1, 1];
    CommutedOp: ARRAY Tree.NodeName [relE..relLE] OF Tree.NodeName =
      [relE, relN, relG, relLE, relL, relGE];
    son[1] _ Exp[son[1], none];  son[2] _ Exp[son[2], none];
    val _ [subtree[index: node]];
    IF ~ComparableSons[node] THEN Log.ErrorTree[sizeClash, son[2]];
    rep1 _ vStack[vI-1].rep;  d1 _ vStack[vI-1].bias;
    rep2 _ vStack[vI].rep;  d2 _ vStack[vI].bias;
    rep _ CommonRep[rep1, rep2];
    IF rep = none THEN
      SELECT name FROM
	relE, relN => Log.WarningTree[mixedRepresentation, val];
	ENDCASE => Log.ErrorTree[mixedRepresentation, val];
    SELECT name FROM
      relE, relN => uc _ FALSE;
      ENDCASE => {
	IF rep1 = unsigned OR rep2 = unsigned THEN {
	  son[1] _ AdjustBias[son[1], -d1];  d1 _ 0;
	  son[2] _ AdjustBias[son[2], -d2];  d2 _ 0};
	uc _ CommonRep[rep, unsigned] # none};
    IF d1 # d2 THEN
      IF (~uc AND TreeLiteral[son[2]]) OR (uc AND d2 > d1) THEN
        son[2] _ AdjustBias[son[2], d1-d2]
      ELSE son[1] _ AdjustBias[son[1], d2-d1];
    IF CommonRep[rep, signed+other] = none THEN {
      SELECT ZeroWarning[name] FROM
	1 => IF TreeLiteral[son[1]] AND TreeLiteralValue[son[1]] = 0 THEN GO TO warn;
	2 => IF TreeLiteral[son[2]] AND TreeLiteralValue[son[2]] = 0 THEN GO TO warn;
	ENDCASE;
      EXITS
	warn => Log.WarningTree[unsignedCompare, val]};
    IF StructuredLiteral[son[1]] AND StructuredLiteral[son[2]] AND ~attr1 THEN {
      val _ Fold[node, rep];  nRegs _ 1}
    ELSE {nRegs _ AdjustRegs[node, CommutedOp[name]]; attr3 _ rep # unsigned};
    VPop[];  VPop[];  VPush[0, both, nRegs];
    RETURN};

  ComparableSons: PROC [node: Tree.Index] RETURNS [BOOLEAN] = {
    OPEN tb[node];
    -- compatibility version
    type1: CSEIndex = OperandType[son[1]];
    n1: CARDINAL = P4.WordsForType[type1];
    type2: CSEIndex = OperandType[son[2]];
    n2: CARDINAL = P4.WordsForType[type2];
    IF n1 = 0 OR n2 = 0 THEN RETURN [FALSE];
    SELECT TRUE FROM
      (n1 = n2) => NULL;
      (seb[type1].typeTag = record AND seb[type2].typeTag = record) =>
	IF n1 < n2 THEN 	-- account for lost discrimination
	  son[2] _ ChopType[son[2], type1]
	ELSE son[1] _ ChopType[son[1], type2];
      ENDCASE => RETURN [FALSE];
    RETURN [ComparableType[type1] OR ComparableType[type2]]};


  In: PROC [node: Tree.Index] RETURNS [val: Tree.Link] = {
    OPEN tb[node];
    bias: INTEGER;
    rep: Repr;
    nRegs: RegCount;
    void, const: BOOLEAN;
    subNode: Tree.Index;
    son[1] _ Exp[son[1], none];  bias _ VBias[];  rep _ VRep[];
--  IF rep = unsigned  THEN
      {son[1] _ AdjustBias[son[1], -bias]; bias _ 0};
    void _ FALSE;  val _ [subtree[index: node]];
    son[2] _ NormalizeRange[son[2]];  subNode _ GetNode[son[2]];
    IF (const _ Interval[subNode, bias, none].const) AND ~tb[node].attr2 THEN
      [] _ ConstantInterval[subNode ! EmptyInterval => {void _ TRUE; RESUME}];
    rep _ CommonRep[rep, VRep[]];
    IF rep = none THEN Log.ErrorTree[mixedRepresentation, val];
    tb[subNode].attr3 _ attr3 _ rep # unsigned;
    SELECT TRUE FROM
      void AND son[1] # Tree.Null => {
	FreeNode[node]; val _ passPtr.tFALSE; nRegs _ 1};
      const AND StructuredLiteral[son[1]] AND ~attr1 => {
	val _ Fold[node, rep]; nRegs _ 1};
      ENDCASE => nRegs _ ComputeRegs[node];
    VPop[];  VPop[];  VPush[0, both, nRegs];  RETURN};

  BoolOp: PROC [node: Tree.Index] RETURNS [val: Tree.Link] = {
    OPEN tb[node];
    b: Tree.Link = IF (name = and) THEN passPtr.tTRUE ELSE passPtr.tFALSE;
    n1, n2, nRegs: RegCount;
    son[1] _ BoolValue[son[1]];  n1 _ VRegs[];
    son[2] _ BoolValue[son[2]];  n2 _ VRegs[];
    IF TreeLiteral[son[1]] THEN {
      IF son[1] = b THEN {val _ son[2]; son[2] _ Tree.Null; nRegs _ n2}
      ELSE {
	val _ IF (name = and) THEN passPtr.tFALSE ELSE passPtr.tTRUE;
	nRegs _ 1};
       FreeNode[node]}
    ELSE
      IF son[2] # b THEN {val _ [subtree[index: node]]; nRegs _ MAX[n1, n2]}
       ELSE {val _ son[1]; son[1] _ Tree.Null; nRegs _ n1; FreeNode[node]};
    VPop[];  VPop[];  VPush[0, both, nRegs];
    RETURN};


  CheckAlt: PROC [t: Tree.Link, target: CSEIndex] RETURNS [Tree.Link] = {
    type: CSEIndex = OperandType[t];
    IF P4.WordsForType[type] # P4.WordsForType[target] THEN
      IF seb[type].typeTag = record AND seb[target].typeTag = record THEN
	t _ PadRecord[t, target]
      ELSE Log.ErrorTree[sizeClash, t];
    RETURN [t]};

  IfExp: PROC [node: Tree.Index, target: Repr] RETURNS [val: Tree.Link] = {
    OPEN tb[node];
    select: Tree.Link;
    rep: Repr;
    nRegs: RegCount;
    bias: INTEGER = BiasForType[info];
    son[1] _ BoolValue[son[1]];  nRegs _ VRegs[];  VPop[];
    IF TreeLiteral[son[1]] THEN {
      IF son[1] # passPtr.tFALSE THEN {select _ son[2]; son[2] _ Tree.Null}
      ELSE {select _ son[3]; son[3] _ Tree.Null};
      FreeNode[node];
      val _ Exp[select, target]}
    ELSE {
      son[2] _ CheckAlt[RValue[son[2], bias, target], info];
      rep _ VRep[]; nRegs _ MAX[VRegs[], nRegs];  VPop[];
      son[3] _ CheckAlt[RValue[son[3], bias, target], info];
      val _ [subtree[index: node]];
      rep _ CommonRep[VRep[], rep];
      IF rep = none  THEN
	  IF target = none THEN {Log.WarningTree[mixedRepresentation, val]; rep _ both}
	  ELSE rep _ target;
      vStack[vI].rep _ rep;  vStack[vI].nRegs _ MAX[VRegs[], nRegs]};
    RETURN};

  CaseExp: PROC [node: Tree.Index, target: Repr, caseBias: INTEGER] RETURNS [val: Tree.Link] = {
    op: Tree.NodeName = tb[node].name;
    type: CSEIndex = tb[node].info;
    bias: INTEGER = BiasForType[type];
    rep: Repr;
    const: BOOLEAN;

    Selection: Tree.Map = {
      v _ CheckAlt[RValue[t, bias, target], type];
      rep _ CommonRep[rep, VRep[]];  VPop[];
      const _ const AND StructuredLiteral[v];
      RETURN};

    rep _ both+other;  const _ TRUE;
    val _ CaseDriver[node, Selection, caseBias];
    IF OpName[val] = op THEN {PushTree[val]; SetAttr[1, const]; val _ PopTree[]};
    IF rep = none THEN
      IF target = none THEN {Log.WarningTree[mixedRepresentation, val]; rep _ both}
      ELSE rep _ target;
    VPush[bias, rep, MaxRegs];
    RETURN};

  BindCaseExp: PROC [node: Tree.Index, target: Repr] RETURNS [Tree.Link] = {
    BoundExp: PROC [t: Tree.Link, labelBias: INTEGER] RETURNS [Tree.Link] = {
      RETURN [CaseExp[GetNode[t], target, labelBias]]};
    RETURN [BindCase[node, casex, BoundExp]]};

  BindTypeExp: PROC [node: Tree.Index, target: Repr] RETURNS [val: Tree.Link] = {
    type: CSEIndex = tb[node].info;
    bias: INTEGER = BiasForType[type];
    rep: Repr;
    const: BOOLEAN;

    Selection: Tree.Map = {
      v _ CheckAlt[RValue[t, bias, target], type];
      rep _ CommonRep[rep, VRep[]];  VPop[];
      const _ const AND StructuredLiteral[v];
      RETURN};

    rep _ both+other;  const _ TRUE;
    val _ BindType[node, Selection];
    IF rep = none THEN
      IF target = none THEN {Log.WarningTree[mixedRepresentation, val]; rep _ both}
      ELSE rep _ target;
    VPush[bias, rep, MaxRegs];
    RETURN};


  MinMax: PROC [node: Tree.Index, target: Repr] RETURNS [val: Tree.Link] = {
    OPEN tb[node];
    const, zeroTest: BOOLEAN;
    rep: Repr;
    nRegs: RegCount;
    k: RegCount = RegsForType[info];

    Item: Tree.Map = {
      v _ RValue[t, 0, target];
      IF ~StructuredLiteral[v] THEN const _ FALSE
      ELSE IF TreeLiteral[v] AND TreeLiteralValue[v] = 0 THEN zeroTest _ TRUE;
      rep _ CommonRep[rep, VRep[]];
      nRegs _ MIN[MAX[nRegs, VRegs[]+k], MaxRegs];  VPop[];  RETURN};

    IF ListLength[son[1]] = 1 THEN {
      val _ Exp[son[1], target]; son[1] _ Tree.Null; FreeNode[node]}
    ELSE {
      const _ TRUE;  zeroTest _ FALSE;  rep _ both+other;  nRegs _ 0;
      son[1] _ UpdateList[son[1], Item];  val _ [subtree[index: node]];
      IF zeroTest AND CommonRep[rep, unsigned] # none THEN
        Log.WarningTree[unsignedCompare, val];
      SELECT rep FROM
	both => rep _ IF target = none THEN both ELSE target;
	none =>
	  IF target = none THEN {Log.ErrorTree[mixedRepresentation, val]; rep _ both}
	  ELSE rep _ target;  
	ENDCASE => NULL;
      IF const AND ~attr1 THEN {
        val _ Fold[node, rep]; rep _ LiteralRep[val, rep]; nRegs _ k}
      ELSE attr3 _ rep # unsigned;
      VPush[0, rep, nRegs]};
    RETURN};


  Nil: PROC [node: Tree.Index] RETURNS [Tree.Link] = {
    type: CSEIndex = tb[node].info;
    n: CARDINAL;
    d: LiteralOps.ValueDescriptor;
    IF tb[node].son[1] # Tree.Null THEN TypeExp[tb[node].son[1]];
    n _ P4.WordsForType[type];
    d _ DESCRIPTOR[Heap.MakeNode[dataPtr.zone, n], n];
    FOR i: CARDINAL IN [0..n) DO d[i] _ 0 ENDLOOP;
    PushLit[LiteralOps.FindDescriptor[d]];
    IF n > 1 THEN {PushNode[mwconst, 1]; SetInfo[type]};
    FreeNode[node];  Heap.FreeNode[dataPtr.zone, BASE[d]];
    VPush[BiasForType[type], RepForType[type], RegsForType[type]];
    RETURN [ForceType[PopTree[], type]]};


  Lengthen: PROC [node: Tree.Index, target: Repr] RETURNS [val: Tree.Link] = {
    OPEN tb[node];
    rep: Repr;
    nRegs: RegCount;
    son[1] _ RValue[son[1], 0, IF target=both THEN unsigned ELSE target];  
    attr1 _ SELECT TypeForm[CanonicalType[OperandType[son[1]]]] FROM
	ref, arraydesc => TRUE,
	ENDCASE => FALSE;
    IF (rep _ VRep[]) = none THEN {Log.ErrorTree[mixedRepresentation, son[1]]; rep _ both};
    attr3 _ CommonRep[rep, unsigned] = none;
    nRegs _ MAX[VRegs[], RegsForType[info]];
    IF ~TreeLiteral[son[1]] OR (attr1 AND TreeLiteralValue[son[1]] # 0--NIL--) THEN
      val _ [subtree[index: node]]
    ELSE {val _ ShortToLong[node, rep]; rep _ LiteralRep[val, rep]};
    VPop[]; VPush[0, IF rep = unsigned AND ~attr1 THEN both ELSE rep, nRegs];
    RETURN};

  Shorten: PROC [node: Tree.Index, target: Repr] RETURNS [val: Tree.Link] = {
    OPEN tb[node];
    rep: Repr;
    nRegs: RegCount;
    son[1] _ RValue[son[1], 0, IF target=both THEN unsigned ELSE target];  
    nRegs _ VRegs[];  rep _ VRep[];  VPop[];
    IF CommonRep[target, unsigned] # none THEN rep _ unsigned;
    attr1 _ checked OR dataPtr.switches['b];
    IF CommonRep[rep, unsigned] = none THEN attr3 _ TRUE
    ELSE {attr3 _ FALSE; info _ dataPtr.typeCARDINAL};
    IF ~StructuredLiteral[son[1]] THEN val _ [subtree[index: node]]
    ELSE {val _ LongToShort[node, rep]; rep _ LiteralRep[val, rep]};
    VPush[0, rep, nRegs];  RETURN};

  Loophole: PROC [node: Tree.Index, target: Repr] RETURNS [val: Tree.Link] = {
    OPEN tb[node];
    type: CSEIndex = info;
    rep: Repr = IF tb[node].son[2] # Tree.Null OR target = none
      THEN RepForType[type]
      ELSE target;
    son[1] _ Exp[son[1], rep];
    IF son[2] # Tree.Null THEN TypeExp[son[2]];
    IF P4.WordsForType[OperandType[son[1]]] # P4.WordsForType[type] THEN
      Log.ErrorTree[sizeClash, son[1]];
    IF RCType[type] # none THEN val _ [subtree[index: node]]
    ELSE {
      val _ ForceType[son[1], type];
      son[1] _ Tree.Null;  FreeNode[node]};
    vStack[vI].rep _ rep;  RETURN};


 
  AdjustBias: PUBLIC PROC [t: Tree.Link, delta: INTEGER] RETURNS [Tree.Link] = {
    op: Tree.NodeName;
    type: CSEIndex;
    IF delta = 0 THEN RETURN [t];
    IF OpName[t] = safen THEN {
      subNode: Tree.Index = GetNode[t];
      tb[subNode].son[1] _ AdjustBias[tb[subNode].son[1], delta];
      RETURN [t]};
    IF t = Tree.Null THEN passPtr.implicitBias _ passPtr.implicitBias + delta;
    type _ OperandType[t];
    IF TreeLiteral[t] THEN RETURN [MakeStructuredLiteral[TreeLiteralValue[t]-delta, type]];
    IF delta > 0 THEN op _ minus ELSE {op _ plus; delta _ -delta};
    PushTree[t];  PushTree[MakeTreeLiteral[delta]];
    PushNode[op, 2];  SetInfo[type];  SetAttr[1, FALSE];  SetAttr[2, FALSE];
    RETURN [PopTree[]]};

  RValue: PUBLIC PROC [exp: Tree.Link, bias: INTEGER, target: Repr]
      RETURNS [val: Tree.Link] = {
    d: INTEGER;
    val _ Exp[exp, target];  d _ bias - vStack[vI].bias;
    IF d # 0 THEN {val _ AdjustBias[val, d]; vStack[vI].bias _ bias};
    RETURN};


  Exp: PUBLIC PROC [exp: Tree.Link, target: Repr] RETURNS [val: Tree.Link] = {
    rep: Repr;
    WITH expr: exp SELECT FROM

      symbol => {
	sei: ISEIndex = expr.index;
	type: CSEIndex;
	IF ~seb[sei].mark4 THEN DeclItem[Tree.Link[subtree[index: seb[sei].idValue]]];
	type _ UnderType[seb[sei].idType];  rep _ RepForType[type];
	IF ~seb[sei].constant THEN val _ expr
	ELSE
	  SELECT XferMode[type] FROM
	    proc, signal, error, program =>
	      val _ IF ConstantId[sei] AND ~seb[sei].extended
		THEN MakeStructuredLiteral[seb[sei].idValue, type]
		ELSE expr;
	    ENDCASE =>
	      IF seb[sei].extended THEN {
		val _ IdentityMap[FindExtension[sei].tree];
		WITH val SELECT FROM
		  subtree => tb[index].info _ type;
		  ENDCASE;
		val _ Exp[val, target];  rep _ VRep[];  VPop[]} 
	      ELSE {
		val _ MakeStructuredLiteral[seb[sei].idValue, type];
		rep _ LiteralRep[val, rep]};
	VPush[BiasForType[type], rep, RegsForType[type]]};

      literal => {
	WITH expr.info SELECT FROM
	  word => rep _ LiteralRep[expr, unsigned];
	  string => {
	    LiteralOps.StringReference[index];
	    MarkString[local: index # LiteralOps.MasterString[index]];
	    rep _ unsigned};
	  ENDCASE => rep _ none;
	VPush[0, rep, 1];  val _ expr};

      subtree =>
	IF expr = Tree.Null THEN {
	  val _ Tree.Null; VPush[passPtr.implicitBias, passPtr.implicitRep, MaxRegs]}
	ELSE {
	  node: Tree.Index = expr.index;
	  SELECT tb[node].name FROM

	    dot => {
	      OPEN tb[node];
	      nRegs: RegCount;
	      son[1] _ RValue[son[1], 0, unsigned];
	      nRegs _ MAX[RegsForType[info], VRegs[]];  VPop[];
	      son[2] _ Exp[son[2], target];  vStack[vI].nRegs _ nRegs;
	      attr1 _ ~attr3 AND (checked OR dataPtr.switches['n]);
	      val _ expr};

	    dollar => val _ Dollar[node];

	    cdot => {
	      val _ Exp[tb[node].son[2], target];
	      tb[node].son[2] _ Tree.Null;  FreeNode[node]};

	    uparrow => {
	      OPEN tb[node];
	      nRegs: RegCount;
	      son[1] _ RValue[son[1], 0, unsigned];
	      nRegs _ MAX[RegsForType[info], VRegs[]];  VPop[];
	      VPush[BiasForType[info], RepForType[info], nRegs];
	      attr1 _ ~attr3 AND (checked OR dataPtr.switches['n]);
	      val _ expr};

	    callx, portcallx, signalx, errorx, startx, joinx => val _ Call[node];
	    substx => val _ Substx[node];
	    index, dindex => val _ Index[node];
	    seqindex => val _ SeqIndex[node];
	    reloc => val _ Reloc[node];
	    construct => val _ Construct[node];
	    union => val _ Union[node];
	    rowcons => val _ RowConstruct[node];
	    all => val _ All[node];
	    uminus => val _ UMinus[node];
	    abs => val _ Abs[node];
	    pred, succ => val _ EnumOp[node, target];
	    plus, minus => val _ AddOp[node, target];
	    times => val _ Mult[node, target];
	    div, mod => val _ DivMod[node, target];
	    relE, relN, relL, relGE, relG, relLE => val _ RelOp[node];
	    in, notin => val _ In[node];

	    not => {
	      tb[node].son[1] _ BoolValue[tb[node].son[1]];
	      IF ~TreeLiteral[tb[node].son[1]] THEN val _ expr
	      ELSE {
		val _ IF tb[node].son[1] # passPtr.tFALSE
		      THEN passPtr.tFALSE
		      ELSE passPtr.tTRUE;
		FreeNode[node];  vStack[vI].nRegs _ 1}};

	    or, and => val _ BoolOp[node];
	    ifx => val _ IfExp[node, target];
	    casex => val _ CaseExp[node, target, 0];
	    bindx => val _ IF tb[node].attr3
				THEN BindTypeExp[node, target]
				ELSE BindCaseExp[node, target];
	    assignx => val _ Assignment[node];
	    extractx => val _ Extract[node];
	    min, max => val _ MinMax[node, target];

	    mwconst => {
	      rep: Repr;
	      val _ expr;  rep _ LiteralRep[val, RepForType[tb[node].info]];
	      VPush[0, rep, RegsForType[tb[node].info]]};

	    clit => {val _ tb[node].son[1]; FreeNode[node]; VPush[0, both, 1]};

	    llit => {
	      IF currentLevel > Symbols.lG THEN
		WITH e: tb[node].son[1] SELECT FROM
		  literal =>
		    WITH e.info SELECT FROM
		      string => index _ LiteralOps.FindLocalString[index];
		      ENDCASE;
		  ENDCASE;
	      val _ Exp[tb[node].son[1], none];
	      tb[node].son[1] _ Tree.Null;  FreeNode[node]};

	    textlit => {
	      nRegs: RegCount = RegsForType[tb[node].info];
	      IF dataPtr.definitionsOnly THEN val _ expr
	      ELSE {
		val _ WITH e: tb[node].son[1] SELECT FROM
		  literal =>
		    WITH e.info SELECT FROM
		      string => SymLiteralOps.TextRef[index],
		      ENDCASE => ERROR,
		  ENDCASE => ERROR;
		FreeNode[node]};
	      VPush[0, unsigned, nRegs]};

	    atom => {
	      IF dataPtr.definitionsOnly THEN val _ expr
	      ELSE {
	        val _ SymLiteralOps.AtomRef[GetHash[tb[node].son[1]]];
		FreeNode[node]};
	      VPush[0, unsigned, 2]};

	    new => val _ New[node];
	    nil => val _ Nil[node];
	    create, fork => val _ MiscXfer[node];
	    syserrorx => {val _ expr; VPush[0, RepForType[tb[node].info], MaxRegs]};
	    lengthen => val _ Lengthen[node, target];
	    shorten => val _ Shorten[node, target];

	    float => {
	      tb[node].son[1] _ RValue[tb[node].son[1], 0, signed];
	      IF StructuredLiteral[tb[node].son[1]] AND vStack[vI].rep # unsigned THEN
		val _ IntToReal[node]
	      ELSE {val _ expr; vStack[vI].nRegs _ MaxRegs};
	      vStack[vI].rep _ other};

	    safen, proccheck => {
	      tb[node].son[1] _ Exp[tb[node].son[1], target]; val _ expr};
	    loophole => val _ Loophole[node, target];


	    cast => {
	      OPEN tb[node];
	      rep: Repr = RepForType[info];
	      son[1] _ Exp[son[1], rep];  vStack[vI].rep _ rep;  val _ expr;
	      IF P4.WordsForType[OperandType[son[1]]] # P4.WordsForType[info] THEN name _ chop;
	      vStack[vI].rep _ rep;  val _ expr};

	    check => {
	      rep: Repr = RepForType[tb[node].info];
	      val _ Rhs[tb[node].son[1], tb[node].info];
	      vStack[vI].rep _ rep;
	      tb[node].son[1] _ Tree.Null;  FreeNode[node]};

	    narrow => val _ Narrow[node];

	    istype => {
	      OPEN tb[node];
	      son[1] _ RValue[son[1], 0, RepForType[OperandType[son[1]]]];  VPop[];
	      TypeExp[son[2]];
	      IF nSons > 2 THEN CatchNest[son[3]];
	      IF attr2 OR attr3 THEN {val _ expr; VPush[0, both, MaxRegs]}
	      ELSE {FreeNode[node]; val _ passPtr.tTRUE; VPush[0, both, 1]}};

	    openx => {
	      OPEN tb[node];
	      type: CSEIndex = OperandType[son[1]];
	      IF attr1 THEN val _ son[1]
	      ELSE {
		son[1] _ NeutralExp[son[1]];
		IF Shared[son[1]] THEN	-- must generate an unshared node
		  son[1] _ ForceType[son[1], type];
		SetShared[son[1], TRUE];  attr1 _ TRUE;
		val _ expr};
	      VPush[0, other, RegsForType[type]]};

	    stringinit => {
	      MarkString[];
	      tb[node].son[2] _ P4.Rhs[tb[node].son[2], dataPtr.typeCARDINAL];  
	      VPop[];
	      val _ expr;  VPush[0, unsigned, MaxRegs]};

	    size, first, last, typecode => val _ TypeOp[node];
	    apply => {VPush[0, none, 0]; val _ expr};

	    ENDCASE => val _ AddrOp[node]};

      ENDCASE => ERROR;
    RETURN};

  NeutralExp: PUBLIC PROC [exp: Tree.Link] RETURNS [val: Tree.Link] = {
    val _ RValue[exp, 0, none]; VPop[]; RETURN};

  }.