-- file Pass4S.Mesa
-- last modified by Satterthwaite, December 11, 1979  9:07 AM

DIRECTORY
  AltoDefs: FROM "altodefs" USING [wordlength],
  ComData: FROM "comdata"
    USING [
      bodyIndex, definitionsOnly, monitored, nTypeCodes, switches, textIndex,
      typeMap, typeMapId,
      typeBOOLEAN, typeINTEGER, typeLOCK],
  ControlDefs: FROM "controldefs"
    USING [StateVector, EPRange, localbase],
  InlineDefs: FROM "inlinedefs" USING [BITAND],
  Log: FROM "log" USING [Error, ErrorSei, ErrorTree],
  LiteralOps: FROM "literalops"
    USING [Find, FindDescriptor, ResetLocalStrings],
  P4: FROM "p4"
    USING [
      Repr, none, unsigned, both, other,
      AdjustBias, Assignment, BiasForType, Call, CheckBlock, --CommonRep,--
      ConstantInterval, Cover, DeclItem, DeclUpdate, Exp, Interval,
      LayoutBlock, LayoutGlobals, LayoutInterface, LayoutLocals,
      MakeArgRecord, MakeTreeLiteral, NeutralExp, NormalizeRange,
      OperandType, RelTest, RepForType, Rhs, RValue, TargetRep,
      TreeLiteral, TreeLiteralValue, VBias, VPop, VRep, WordsForType,
      EmptyInterval],
  Pass4: FROM "pass4"
    USING [
      implicitBias, implicitRep, implicitType, lockNode, resident,
      resumeRecord, returnRecord, tFALSE, tTRUE],
  Symbols: FROM "symbols"
    USING [seType, ctxType, bodyType,
      ISEIndex, CSEIndex, RecordSEIndex, BTIndex, CBTIndex, ContextLevel,
      SENull, RecordSENull, BTNull, lG, lL, typeANY],
  SymbolOps: FROM "symbolops"
    USING [
      Cardinality, ContextVariant, FirstVisibleSe, NextSe,
      NormalType, TransferTypes, UnderType],
  SystemDefs: FROM "systemdefs" USING [FreeHeapNode],
  Table: FROM "table" USING [Base, Notifier],
  Tree: FROM "tree"
    USING [treeType, Index, Link, Map, NodeName, Scan, Null, NullIndex],
  TreeOps: FROM "treeops"
    USING [
      FreeNode, FreeTree, GetNode, ListLength, MakeList, MakeNode,
      PopTree, PushProperList, PushList, PushLit, PushNode, PushTree,
      ReverseScanList, ReverseUpdateList, ScanList,
      SetAttr, SetInfo, SetShared, TestTree, UpdateList];

Pass4S: PROGRAM
    IMPORTS
	InlineDefs, Log, LiteralOps, P4, SymbolOps, SystemDefs, TreeOps,
	dataPtr: ComData, passPtr: Pass4
    EXPORTS P4 =
  BEGIN
  OPEN SymbolOps, Symbols, P4, TreeOps;

  CommonRep: PROCEDURE [Repr, Repr] RETURNS [Repr] =
    LOOPHOLE[InlineDefs.BITAND];

  tb: Table.Base;	-- tree base address (local copy)
  seb: Table.Base;	-- se table base address (local copy)
  ctxb: Table.Base;	-- ctx table base address (local copy)
  bb: Table.Base;	-- body table base (local copy)

  StmtNotify: PUBLIC Table.Notifier =
    BEGIN  -- called by allocator whenever table area is repacked
    tb ← base[Tree.treeType];
    seb ← base[seType];  ctxb ← base[ctxType];  bb ← base[bodyType];
    END;

  WordLength: CARDINAL = AltoDefs.wordlength;
  Repr: TYPE = P4.Repr;
    none: Repr = P4.none;


 -- bodies and blocks

  BodyList: PUBLIC PROCEDURE [firstBti: BTIndex] =
    BEGIN
    bti: BTIndex;
    IF (bti ← firstBti) # BTNull
      THEN
	DO
	WITH bb[bti] SELECT FROM
	  Callable =>
	    IF ~inline
	     OR (dataPtr.definitionsOnly AND LocalBody[LOOPHOLE[bti]])
	      THEN Body[LOOPHOLE[bti, CBTIndex]];
	  ENDCASE => BodyList[bb[bti].firstSon];
	IF bb[bti].link.which = parent THEN EXIT;
	bti ← bb[bti].link.index;
	ENDLOOP;
    END;

  LocalBody: PROCEDURE [bti: CBTIndex] RETURNS [BOOLEAN] = INLINE
    BEGIN
    sei: ISEIndex = bb[bti].id;
    RETURN [sei = SENull OR ctxb[seb[sei].idCtx].ctxType = simple]
    END;


  Body: PROCEDURE [bti: CBTIndex] =
    BEGIN
    oldBodyIndex: CBTIndex = dataPtr.bodyIndex;
    saveIndex: CARDINAL = dataPtr.textIndex;
    saveCatchScope: BOOLEAN = catchScope;
    saveRecord: RecordSEIndex = passPtr.returnRecord;
    node: Tree.Index;
    sei: CSEIndex;
    base, bound: CARDINAL;
    initTree: Tree.Link;
    catchScope ← FALSE;
    dataPtr.bodyIndex ← bti;
    WITH bb[bti].info SELECT FROM
      Internal =>  BEGIN node ← bodyTree; dataPtr.textIndex ← sourceIndex END;
      ENDCASE =>  ERROR;
    IF dataPtr.definitionsOnly AND bb[bti].level > lL
      THEN  Log.ErrorSei[nonDefinition, bb[bti].id];
    sei ← UnderType[bb[bti].ioType];
    passPtr.returnRecord ← TransferTypes[sei].typeOut;
    [] ← LiteralOps.ResetLocalStrings[];
    IF bb[bti].level = lG THEN FillTypeMap[];
    IF tb[node].son[4] # Tree.Null
      THEN  BEGIN tb[node].son[4] ← Exp[tb[node].son[4], none]; VPop[] END;
    tb[node].son[1] ← UpdateList[tb[node].son[1], OpenItem];
    ScanList[tb[node].son[2], DeclItem];
    base ← SELECT bb[bti].level FROM
      lG => LayoutGlobals[bti],
      ENDCASE => LayoutLocals[bti];
    initTree ← Tree.Null;
    SELECT bb[bti].level FROM
      lG =>
	BEGIN
	IF dataPtr.monitored AND tb[passPtr.lockNode].attr1
	  THEN
	    BEGIN
	    PushTree[tb[passPtr.lockNode].son[2]];
	    PushLit[LiteralOps.Find[100000B]];  PushNode[cast, 1];
	    SetInfo[dataPtr.typeLOCK];
	    PushNode[assign, 2];  SetAttr[1, FALSE];  initTree ← PopTree[];
	    END;
	IF dataPtr.nTypeCodes # 0
	  THEN
	    BEGIN
	    PushTree[TypeMapInit[]];
	    IF initTree # Tree.Null
	      THEN BEGIN PushTree[initTree]; PushList[-2] END;
	    initTree ← PopTree[];
	    END;
	END;
      ENDCASE =>
	IF bb[bti].firstSon # BTNull
	  THEN  initTree ← BodyInitList[bb[bti].firstSon];
    tb[node].son[3] ← UpdateList[tb[node].son[3], Stmt];
    bound ← AssignSubBlocks[bti, base];
    WITH bb[bti].info SELECT FROM
      Internal =>
	BEGIN
	frameSize ← (bound + (WordLength-1))/WordLength;
	thread ← LiteralOps.ResetLocalStrings[];
	END;
      ENDCASE;
    bb[bti].resident ← passPtr.resident;
    IF bb[bti].firstSon # BTNull
      THEN BodyList[bb[bti].firstSon]
      ELSE tb[node].son[1] ← ReverseUpdateList[tb[node].son[1], CloseItem];
    tb[node].son[2] ← UpdateList[tb[node].son[2], DeclUpdate];
    IF initTree # Tree.Null
      THEN
	BEGIN  PushTree[initTree];
	IF tb[node].son[2] # Tree.Null
	  THEN  BEGIN  PushTree[tb[node].son[2]];  PushList[2]  END;
	tb[node].son[2] ← PopTree[];
	END;
    IF dataPtr.definitionsOnly AND bb[bti].level = lG 
      THEN
	BEGIN
	n: CARDINAL = LayoutInterface[bti];
	WITH seb[sei] SELECT FROM
	  definition =>
	    nGfi ← IF n=0 THEN 1 ELSE (n-1)/ControlDefs.EPRange + 1;
	  ENDCASE; 
	END;
    catchScope ← saveCatchScope;
    dataPtr.bodyIndex ← oldBodyIndex;  dataPtr.textIndex ← saveIndex;
    passPtr.returnRecord ← saveRecord;
    IF bb[bti].level = lG AND dataPtr.nTypeCodes # 0
      THEN  SystemDefs.FreeHeapNode[BASE[dataPtr.typeMap]];
    END;

  BodyInitList: PROCEDURE [firstBti: BTIndex] RETURNS [Tree.Link] =
    BEGIN
    bti: BTIndex;
    n: CARDINAL;
    n ← 0;
    IF (bti ← firstBti) # BTNull
      THEN
	DO
	WITH body: bb[bti] SELECT FROM
	  Callable =>
	    IF ~body.inline
	      THEN  BEGIN PushNode[procinit, 0]; SetInfo[bti]; n ← n+1 END;
	  ENDCASE => NULL;
	IF bb[bti].link.which = parent THEN EXIT;
	bti ← bb[bti].link.index;
	ENDLOOP;
    RETURN [MakeList[n]]
    END;

  AssignSubBlocks: PROCEDURE [rootBti: BTIndex, base: CARDINAL] RETURNS [bound: CARDINAL] =
    BEGIN
    level: ContextLevel = bb[rootBti].level;
    bti: BTIndex;
    bound ← base;
    IF (bti ← bb[rootBti].firstSon) # BTNull
      THEN
	DO
	SELECT bb[bti].kind FROM
	  Other =>
	    IF bb[bti].level = level
	      THEN  bound ← MAX[AssignBlock[bti, base], bound];
	  ENDCASE => NULL;
	IF bb[bti].link.which = parent THEN EXIT;
	bti ← bb[bti].link.index;
	ENDLOOP;
    RETURN
    END;


  Subst: PUBLIC PROCEDURE [node: Tree.Index] RETURNS [Tree.Link] =
    BEGIN  OPEN tb[node];
    saveRecord: RecordSEIndex = passPtr.returnRecord;
    son[1] ← NeutralExp[son[1]];
    passPtr.returnRecord ← TransferTypes[OperandType[son[1]]].typeOut;
    son[2] ← UpdateList[son[2], Stmt];
    passPtr.returnRecord ← saveRecord;
    RETURN [Tree.Link[subtree[index: node]]]
    END;


  Block: PROCEDURE [node: Tree.Index] RETURNS [Tree.Link] =
    BEGIN  OPEN tb[node];
    bti: BTIndex = info;
    saveIndex: CARDINAL = dataPtr.textIndex;
    initTree: Tree.Link ← Tree.Null;
    WITH bb[bti].info SELECT FROM
      Internal =>  dataPtr.textIndex ← sourceIndex;
      ENDCASE;
    ScanList[son[1], DeclItem];
    CheckBlock[bti];
    son[2] ← UpdateList[son[2], Stmt];
    son[1] ← UpdateList[son[1], DeclUpdate];
    IF catchScope
      THEN catchBound ← MAX[AssignBlock[bti, catchBase], catchBound];
    dataPtr.textIndex ← saveIndex;
    RETURN [Tree.Link[subtree[index: node]]]
    END;

  AssignBlock: PROCEDURE [bti: BTIndex, base: CARDINAL] RETURNS [bound: CARDINAL] =
    BEGIN
    node: Tree.Index;
    newBase: CARDINAL;
    initTree: Tree.Link ← Tree.Null;
    newBase ← LayoutBlock[bti, base];
    IF bb[bti].level # lG AND bb[bti].firstSon # BTNull
      THEN  initTree ← BodyInitList[bb[bti].firstSon];
    bound ← AssignSubBlocks[bti, newBase];
    WITH bb[bti].info SELECT FROM
      Internal =>
	BEGIN
	frameSize ← (bound + (WordLength-1))/WordLength;  node ← bodyTree;
	END;
      ENDCASE => NULL;
    IF initTree # Tree.Null
      THEN
	BEGIN  OPEN tb[node];
	PushTree[initTree];
	IF son[1] # Tree.Null THEN BEGIN PushTree[son[1]]; PushList[2] END;
	son[1] ← PopTree[];
	END;
    RETURN
    END;


 -- type map

  FillTypeMap: PROCEDURE =
    BEGIN
    mapType, subType: CSEIndex;
    sei: ISEIndex = dataPtr.typeMapId;
    IF sei # SENull
      THEN
	BEGIN
	mapType ← UnderType[seb[sei].idType];
	WITH seb[mapType] SELECT FROM
	  array =>
	    BEGIN
	    subType ← UnderType[indexType];
	    WITH seb[subType] SELECT FROM
	      subrange =>
		BEGIN
		origin ← 0;
		IF dataPtr.nTypeCodes # 0
		  THEN  range ← dataPtr.nTypeCodes - 1
		  ELSE  BEGIN empty ← TRUE; range ← 0 END;
		filled ← mark4 ← TRUE;
		END;
	      ENDCASE => ERROR;
	    mark4 ← TRUE;
	    END;
	  ENDCASE => ERROR;
	seb[sei].mark4 ← TRUE;
	END;
    END;

  TypeMapInit: PROCEDURE RETURNS [Tree.Link] =
    BEGIN
    PushTree[[symbol[index: dataPtr.typeMapId]]];
    PushLit[LiteralOps.FindDescriptor[
      DESCRIPTOR[BASE[dataPtr.typeMap], dataPtr.nTypeCodes, WORD]]];
    PushNode[mwconst, 1]; SetInfo[UnderType[seb[dataPtr.typeMapId].idType]];
    PushNode[assign, 2];  SetAttr[1, FALSE];
    -- generate a descriptor
      PushTree[[symbol[index: dataPtr.typeMapId]]];
      PushNode[addr, 1];  SetInfo[typeANY];  SetAttr[2, FALSE];
      PushLit[LiteralOps.Find[dataPtr.nTypeCodes]];
      PushList[2];
    PushLit[LiteralOps.Find[277B]];
    PushNode[syscall, -2];  PushList[2];
    RETURN [PopTree[]]
    END;


 -- main dispatch

  Stmt: PROCEDURE [stmt: Tree.Link] RETURNS [val: Tree.Link] =
    BEGIN
    node: Tree.Index;
    saveIndex: CARDINAL = dataPtr.textIndex;
    val ← stmt;		-- the default case
    WITH stmt SELECT FROM
      subtree =>
	BEGIN  node ← index;
	IF node # Tree.NullIndex
	  THEN
	    BEGIN  OPEN tb[node];
	    dataPtr.textIndex ← info;
	    SELECT name FROM

	      assign =>
		BEGIN  val ← Assignment[node];  VPop[]  END;

	      extract =>  Extract[node];

	      call, portcall, signal, error, xerror, start, join =>
		BEGIN  val ← Call[node];  VPop[]  END;

	      subst =>  val ← Subst[node];
	      block =>  val ← Block[node];
	      if =>  val ← IfStmt[node];
	      case =>  val ← CaseDriver[node, Stmt, 0];
	      bind =>  val ← Binding[node, case, BindStmt];
	      do =>  val ← DoStmt[node];

	      return, result =>
		son[1] ← MakeArgRecord[passPtr.returnRecord, son[1]];

	      label =>
		BEGIN
		son[1] ← Stmt[son[1]];
		son[2] ← UpdateList[son[2], Stmt];
		END;

	      goto, exit, loop, syserror, continue, retry, null =>  NULL;

	      restart =>
		BEGIN
		son[1] ← NeutralExp[son[1]];
		IF nSons > 2 THEN CatchNest[son[3]];
		END;

	      stop =>  CatchNest[son[1]];

	      lock =>
		BEGIN
		son[1] ← UpdateList[son[1], Stmt];
		son[2] ← Exp[son[2], none];  VPop[];
		END;

	      wait =>
		BEGIN
		son[1] ← Exp[son[1], none];  VPop[];
		son[2] ← Exp[son[2], none];  VPop[];
		IF nSons > 2 THEN CatchNest[son[3]];
		END;

	      notify, broadcast, unlock =>
		BEGIN  son[1] ← Exp[son[1], none];  VPop[]  END;

	      open =>
		BEGIN
		son[1] ← UpdateList[son[1], OpenItem];
		son[2] ← UpdateList[son[2], Stmt];
		END;

	      enable =>
		BEGIN  CatchPhrase[son[1]];  son[2] ← Stmt[son[2]]  END;

	      resume =>
		son[1] ← MakeArgRecord[passPtr.resumeRecord, son[1]];

	      catchmark =>  son[1] ← Stmt[son[1]];

	      dst, lst, lstf =>
		BEGIN
		son[1] ← Exp[son[1], none];
		IF WordsForType[OperandType[son[1]]] #
		    SIZE[ControlDefs.StateVector]
		  THEN Log.ErrorTree[sizeClash, son[1]];
		VPop[];
		END;

	      apply =>  NULL;
	      item =>  son[2] ← Stmt[son[2]];
	      list =>  val ← UpdateList[stmt, Stmt];

	      ENDCASE =>  Log.Error[unimplemented];
	    END;
	END;
      ENDCASE =>  ERROR;
    dataPtr.textIndex ← saveIndex;  RETURN
    END;


 -- extraction

  Extract: PROCEDURE [node: Tree.Index] =
    BEGIN

    AssignItem: Tree.Map =
      BEGIN
      type: CSEIndex;
      saveType: CSEIndex = passPtr.implicitType;
      saveBias: INTEGER = passPtr.implicitBias;
      saveRep: Repr = passPtr.implicitRep;
      IF t = Tree.Null
	THEN v ← Tree.Null
	ELSE
	  BEGIN
	  subNode: Tree.Index = GetNode[t];
	  type ← UnderType[seb[sei].idType];
	  passPtr.implicitType ← type;
	  passPtr.implicitBias ← BiasForType[type];
	  passPtr.implicitRep ← RepForType[type];
	  IF tb[subNode].name = extract
	    THEN  BEGIN Extract[subNode]; v ← t END
	    ELSE  BEGIN v ← Assignment[subNode]; VPop[] END;
	  END;
      sei ← NextSe[sei];
      passPtr.implicitRep ← saveRep;  passPtr.implicitBias ← saveBias;
      passPtr.implicitType ← saveType;  RETURN
      END;

    subNode: Tree.Index = GetNode[tb[node].son[1]];
    rType: RecordSEIndex = tb[subNode].info;
    sei: ISEIndex;
    seb[rType].lengthUsed ← TRUE;
    sei ← FirstVisibleSe[seb[rType].fieldCtx];
    tb[subNode].son[1] ← UpdateList[tb[subNode].son[1], AssignItem];
    tb[node].son[2] ← Exp[tb[node].son[2], none];  VPop[];
    END;


 -- conditionals

  IfStmt: PROCEDURE [node: Tree.Index] RETURNS [val: Tree.Link] =
    BEGIN  OPEN tb[node];
    son[1] ← NeutralExp[son[1]];
    son[2] ← Stmt[son[2]];  son[3] ← Stmt[son[3]];
    IF ~TreeLiteral[son[1]]
      THEN  val ← Tree.Link[subtree[index: node]]
      ELSE
	BEGIN
	IF son[1] # passPtr.tFALSE
	  THEN  BEGIN  val ← son[2];  son[2] ← Tree.Null  END
	  ELSE  BEGIN  val ← son[3];  son[3] ← Tree.Null  END;
	FreeNode[node];
	END;
    RETURN
    END;

 
  BindStmt: PROCEDURE [t: Tree.Link, labelBias: INTEGER] RETURNS [Tree.Link] =
    BEGIN
    node: Tree.Index = GetNode[t];
    RETURN [CaseDriver[GetNode[t], Stmt, labelBias]]
    END;


  -- drivers for processing selections

  Binding: PUBLIC PROCEDURE [
	node: Tree.Index,
	op: Tree.NodeName,
	eval: PROCEDURE [Tree.Link, INTEGER] RETURNS [Tree.Link]]
      RETURNS [val: Tree.Link] =
    BEGIN  OPEN tb[node];
    labelBias: INTEGER = TagBias[OpenedType[son[1]]];
    subNode: Tree.Index;
    PushTree[son[2]];  son[2] ← Tree.Null;
    PushTree[son[3]];  son[3] ← Tree.Null;
    PushTree[son[4]];  son[4] ← Tree.Null;
    PushTree[OpenItem[son[1]]];  son[1] ← Tree.Null;
    PushNode[op, 4];  SetInfo[info];  SetAttr[1, FALSE];
    val ← eval[PopTree[], labelBias];  subNode ← GetNode[val];
    tb[subNode].son[4] ← CloseItem[tb[subNode].son[4]];
    FreeNode[node];  RETURN
    END;

  TagBias: PROCEDURE [rType: CSEIndex] RETURNS [INTEGER] =
    BEGIN
    sei: ISEIndex = WITH seb[rType] SELECT FROM
			record => ContextVariant[fieldCtx],
			ENDCASE => ERROR;
    uType: CSEIndex = UnderType[seb[sei].idType];
    RETURN [WITH seb[uType] SELECT FROM
      union => BiasForType[UnderType[seb[tagSei].idType]],
      ENDCASE => 0]
    END;


  CaseDriver: PUBLIC PROCEDURE [
	node: Tree.Index, selection: Tree.Map, labelBias: INTEGER]
      RETURNS [val: Tree.Link] =
    BEGIN  OPEN tb[node];
    type: CSEIndex = OperandType[son[1]];
    son[1] ← Exp[son[1], none];
    IF type = dataPtr.typeBOOLEAN AND attr1 AND TreeLiteral[son[1]]
      THEN
	BEGIN

	CaseItem: Tree.Scan =
	  BEGIN
	  subNode: Tree.Index = GetNode[t];
	  started: BOOLEAN;

	  PushTest: Tree.Scan =
	    BEGIN
	    tNode: Tree.Index = GetNode[t];
	    PushTree[tb[tNode].son[2]];  tb[tNode].son[2] ← Tree.Null;
	    IF son[1] = passPtr.tFALSE THEN PushNode[not, 1];
	    IF started THEN PushNode[or, 2];
	    started ← TRUE;  RETURN
	    END;

	  PushTree[tb[subNode].son[2]];  tb[subNode].son[2] ← Tree.Null;
	  started ← FALSE;  ScanList[tb[subNode].son[1], PushTest];
	  IF selection = Stmt
	    THEN  BEGIN PushNode[if, -3]; SetInfo[tb[subNode].info] END
	    ELSE  BEGIN PushNode[ifx, -3]; SetInfo[tb[node].info] END;
	  RETURN
	  END;

	son[1] ← AdjustBias[son[1], -VBias[]];  VPop[];
	PushTree[son[3]];  son[3] ← Tree.Null;
	ReverseScanList[son[2], CaseItem];
	FreeNode[node];
	val ← selection[PopTree[]];
	END
      ELSE
	BEGIN
	nSons: CARDINAL = ListLength[son[2]];
	i, j, first, last, next, newSons: CARDINAL;
	min, max: INTEGER;
	minTree, maxTree: Tree.Link;
	rep: Repr;
	subNode, listNode: Tree.Index;
	switchable, copying: BOOLEAN;
	multiword: BOOLEAN = WordsForType[type] # 1;
	count: CARDINAL;

	SwitchValue: Tree.Map =
	  BEGIN
	  val: Tree.Link;
	  tNode: Tree.Index = GetNode[t];
	  val ← tb[tNode].son[2] ←
		RValue[tb[tNode].son[2], passPtr.implicitBias, rep];
	  VPop[];
	  IF count = 0
	    THEN  BEGIN  first ← i;  minTree ← maxTree ← val  END
	    ELSE
	      BEGIN
	      subRep: Repr =
		(SELECT rep FROM other, none => unsigned, ENDCASE => rep);
	      IF RelTest[val, minTree, relL, subRep] THEN minTree ← val;
	      IF RelTest[val, maxTree, relG, subRep] THEN maxTree ← val;
	      END;
	  count ← count + 1;
	  RETURN [t]
	  END;

	saveType: CSEIndex = passPtr.implicitType;
	saveBias: INTEGER = passPtr.implicitBias;
	saveRep: Repr = passPtr.implicitRep;
	passPtr.implicitType ← type;
	passPtr.implicitBias ← VBias[] - labelBias;
	passPtr.implicitRep ← rep ← VRep[];  VPop[];
	newSons ← nSons;
	i ← next ← 1;  copying ← FALSE;  listNode ← GetNode[son[2]];
	UNTIL i > nSons
	  DO
	  WHILE i <= nSons
	    DO
	    subNode ← GetNode[tb[listNode].son[i]];
	    IF tb[subNode].attr1 AND ~multiword THEN EXIT;
	    tb[subNode].son[1] ← UpdateList[tb[subNode].son[1], NeutralExp];
	    tb[subNode].son[2] ← selection[tb[subNode].son[2]];
	    i ← i+1;
	    ENDLOOP;
	  switchable ← FALSE;  count ← 0;
	  WHILE i <= nSons
	    DO  -- N.B. implicitbias is never changed by this loop
	    subNode ← GetNode[tb[listNode].son[i]];
	    IF ~tb[subNode].attr1 OR multiword THEN EXIT;
	    tb[subNode].son[1] ← UpdateList[tb[subNode].son[1], SwitchValue];
	    tb[subNode].son[2] ← selection[tb[subNode].son[2]];
	    switchable ← TRUE;  last ← i;  i ← i+1;
	    ENDLOOP;
	  IF switchable
	   AND SwitchWorthy[count,
	      (max←TreeLiteralValue[maxTree])-(min←TreeLiteralValue[minTree])]
	    THEN
	      BEGIN  copying ← TRUE;
	      FOR j IN [next .. first)
		DO  PushTree[tb[listNode].son[j]]  ENDLOOP;
	      PushTree[AdjustBias[Tree.Null, min]];
	      PushTree[MakeTreeLiteral[max-min+1]];
	      FOR j IN [first .. last]
		DO  PushTree[SwitchTree[tb[listNode].son[j], min]]  ENDLOOP;
	      PushProperList[last-first+1];
	      PushNode[caseswitch, 3];
	      next ← last+1;  newSons ← newSons - (last-first);
	      END;
	  ENDLOOP;
	IF copying
	  THEN
	    BEGIN
	    FOR j IN [next .. nSons] DO PushTree[tb[listNode].son[j]] ENDLOOP;
	    PushProperList[newSons];  son[2] ← PopTree[];
	    END;
	son[3] ← selection[son[3]];
	val ← Tree.Link[subtree[index: node]];
	passPtr.implicitRep ← saveRep;  passPtr.implicitBias ← saveBias;
	passPtr.implicitType ← saveType;
	END;
    RETURN
    END;

  -- auxiliary routines for CaseDriver

    SwitchWorthy: PROCEDURE [entries, delta: CARDINAL] RETURNS [BOOLEAN] =
      -- the decision function for using a switch
      BEGIN  RETURN [delta < 77777B AND delta+6 < 3*entries]
      END;

    SwitchTree: PROCEDURE [t: Tree.Link, offset: INTEGER] RETURNS [Tree.Link] =
      BEGIN
      node: Tree.Index = GetNode[t];
      count: CARDINAL;

      PushSwitchEntry: Tree.Scan =
	BEGIN
	subNode: Tree.Index = GetNode[t];
	count ← count+1;
	PushTree[MakeTreeLiteral[
		TreeLiteralValue[tb[subNode].son[2]]-offset]];
	END;

      count ← 0;  ScanList[tb[node].son[1], PushSwitchEntry];
      PushList[count];  PushTree[tb[node].son[2]];
      tb[node].son[2] ← Tree.Null;  FreeNode[node];
      RETURN [MakeNode[casetest, 2]]
      END;


 -- iterative statements

  DoStmt: PROCEDURE [node: Tree.Index] RETURNS [val: Tree.Link] =
    BEGIN  OPEN tb[node];
    delete: BOOLEAN ← FALSE;
    IF son[1] # Tree.Null THEN delete ← ForClause[GetNode[son[1]]].empty;
    IF son[2] # Tree.Null
      THEN
	BEGIN  son[2] ← NeutralExp[son[2]];
	SELECT son[2] FROM
	  passPtr.tTRUE => son[2] ← FreeTree[son[2]];
	  passPtr.tFALSE => delete ← TRUE;
	  ENDCASE;
	END;
    son[3] ← UpdateList[son[3], OpenItem];
    son[4] ← UpdateList[son[4], Stmt];
    son[5] ← UpdateList[son[5], Stmt];
    son[6] ← UpdateList[son[6], Stmt];
    son[3] ← ReverseUpdateList[son[3], CloseItem];
    IF ~delete
      THEN  val ← Tree.Link[subtree[index: node]]
      ELSE  BEGIN  FreeNode[node];  val ← Tree.Null  END;
    RETURN
    END;

  ForClause: PROCEDURE [node: Tree.Index] RETURNS [empty: BOOLEAN] =
    BEGIN
    idBias: INTEGER;
    idRep, target, rep: Repr;
    idType, type1, type2: CSEIndex;
    iNode: Tree.Index;
    range: CARDINAL;
    empty ← FALSE;
    IF tb[node].son[1] = Tree.Null
      THEN
	BEGIN
	idType ← dataPtr.typeINTEGER;
	idBias ← 0;  idRep ← both;  target ← none;
	END
      ELSE
	BEGIN
	idType ← OperandType[tb[node].son[1]];
	tb[node].son[1] ← Exp[tb[node].son[1], none];
	idBias ← VBias[];  idRep ← VRep[]; target ← TargetRep[idRep];  VPop[];
	END;
    SELECT tb[node].name FROM
      forseq =>
	BEGIN
	tb[node].son[2] ← Rhs[tb[node].son[2], idType];  VPop[];
	tb[node].son[3] ← Rhs[tb[node].son[3], idType];  VPop[];
	END;
      upthru, downthru =>
	BEGIN
	tb[node].son[2] ← NormalizeRange[tb[node].son[2]];
	iNode ← GetNode[tb[node].son[2]];
	type1 ← OperandType[tb[iNode].son[1]];
	type2 ← OperandType[tb[iNode].son[2]];
	IF (tb[node].attr1 ← Interval[iNode, idBias, idRep].const)
	  THEN [] ← ConstantInterval[iNode
			!EmptyInterval => BEGIN empty ← TRUE; RESUME END];
	rep ← CommonRep[VRep[], idRep];
	tb[iNode].attr3 ← rep # unsigned;  VPop[];
	IF rep = none OR (rep = unsigned AND idBias > 0)
	  THEN Log.ErrorTree[mixedRepresentation, tb[node].son[2]];
	SELECT TRUE FROM
	  empty => NULL;
	  WordsForType[idType] = 0 =>
	    Log.ErrorTree[sizeClash, tb[node].son[1]];
	  idType # dataPtr.typeINTEGER AND idType # typeANY =>
	    BEGIN  OPEN tb[iNode];
	    range ← Cardinality[idType];
	    IF dataPtr.switches['b] AND range # 0 THEN
	      IF (Cover[idType, idRep, type1, rep] # full
		    AND RangeTest[son[1], range] # in)
	       OR
		 (Cover[idType, idRep, type2, rep] # full
		    AND RangeTest[son[2], range] # in)
		THEN tb[node].son[3] ← MakeTreeLiteral[range];
	    IF name = intCC AND type2 # dataPtr.typeINTEGER THEN
	      IF TreeLiteral[son[1]] AND
	       INTEGER[TreeLiteralValue[son[1]]]+idBias <= BiasForType[type2]
		THEN  tb[node].attr1 ← TRUE;
	    IF tb[node].attr1 AND range # 0 THEN	-- nonempty interval
	      BEGIN
	      IF (name=intCC OR name=intCO) AND RangeTest[son[1], range] = out
		THEN Log.ErrorTree[boundsFault, son[1]];
	      IF (name=intCC OR name=intOC) AND RangeTest[son[2], range] = out
		THEN Log.ErrorTree[boundsFault, son[2]];
	      END;
	    END;
	  ENDCASE;
	END;
      ENDCASE =>  ERROR;
    RETURN
    END;

  RangeTest: PROCEDURE [t: Tree.Link, range: CARDINAL] RETURNS [{in, out, unknown}] =
    BEGIN
    RETURN [IF TreeLiteral[t]
	THEN IF TreeLiteralValue[t] < range THEN in ELSE out
	ELSE unknown]
    END;


 -- basing

  OpenedType: PROCEDURE [t: Tree.Link] RETURNS [CSEIndex] =
    BEGIN
    node: Tree.Index = GetNode[t];
    type: CSEIndex = NormalType[OperandType[tb[node].son[2]]];
    RETURN [WITH seb[type] SELECT FROM
      pointer => UnderType[refType],
      ENDCASE => type]
    END;

  OpenItem: Tree.Map =
    BEGIN
    node: Tree.Index = GetNode[t];
    IF ~TestTree[tb[node].son[2], openx]
      THEN  v ← Tree.Null
      ELSE
	BEGIN
	v ← NeutralExp[tb[node].son[2]];  tb[node].son[2] ← Tree.Null;
	END;
    FreeNode[node];
    RETURN
    END;

  CloseItem: Tree.Map =
    BEGIN
    node: Tree.Index;
    IF ~TestTree[t, openx]
      THEN  v ← t
      ELSE
	BEGIN
	SetShared[t, FALSE];  node ← GetNode[t];
	v ← tb[node].son[1];  tb[node].son[1] ← Tree.Null;  FreeNode[node];
	END;
    RETURN
    END;


 -- catch phrases

  CatchFrameBase: CARDINAL = (ControlDefs.localbase+1)*WordLength;
  catchScope: BOOLEAN;
  catchBase: CARDINAL;
  catchBound: CARDINAL;

  CatchNest: PUBLIC PROCEDURE [t: Tree.Link] =
    BEGIN
    IF t # Tree.Null THEN CatchPhrase[t];
    END;

  CatchPhrase: PROCEDURE [t: Tree.Link] =
    BEGIN
    node: Tree.Index = GetNode[t];
    saveCatchScope: BOOLEAN = catchScope;
    saveCatchBase: CARDINAL = catchBase;
    saveCatchBound: CARDINAL = catchBound;
    bound: CARDINAL;

    CatchTest: Tree.Map =
      BEGIN
      PushTree[Tree.Null];  PushTree[Exp[t, none]];  VPop[];
      PushNode[relE, 2];  SetInfo[dataPtr.typeBOOLEAN];
      RETURN [PopTree[]]
      END;

    CatchItem: Tree.Scan =
      BEGIN
      node: Tree.Index = GetNode[t];
      type: CSEIndex = tb[node].info;
      saveRecord: RecordSEIndex = passPtr.resumeRecord;
      tb[node].son[1] ← UpdateList[tb[node].son[1], CatchTest];
      catchBase ← CatchFrameBase;
      IF type = SENull
	THEN  passPtr.resumeRecord ← RecordSENull
	ELSE
	  WITH seb[type] SELECT FROM
	  transfer =>
	    BEGIN  passPtr.resumeRecord ← outRecord;
	    catchBase ← catchBase + ArgLength[inRecord]+ArgLength[outRecord];
	    END;
	  ENDCASE =>  ERROR;
      catchBound ← catchBase;
      tb[node].son[2] ← Stmt[tb[node].son[2]];
      bound ← MAX[bound, catchBound];
      passPtr.resumeRecord ← saveRecord;
      END;

    catchScope ← TRUE;
    bound ← CatchFrameBase + WordLength;
    ScanList[tb[node].son[1], CatchItem];
    IF tb[node].nSons > 1 THEN
      BEGIN
      catchBound ← catchBase ← CatchFrameBase;
      tb[node].son[2] ← Stmt[tb[node].son[2]];
      bound ← MAX[bound, catchBound];
      END;
    tb[node].info ← (bound + (WordLength-1))/WordLength;
    catchBase ← saveCatchBase;  catchBound ← saveCatchBound;
    catchScope ← saveCatchScope;
    END;

  ArgLength: PROCEDURE [rSei: RecordSEIndex] RETURNS [length: CARDINAL] =
    BEGIN
    IF rSei = SENull
      THEN  length ← 0
      ELSE  BEGIN length ← seb[rSei].length; seb[rSei].lengthUsed ← TRUE  END;
    RETURN
    END;

  END.