-- file Pass4S.mesa
-- last modified by Satterthwaite, May 10, 1983 4:23 pm
-- last modified by Sweet, January 21, 1981  10:50 PM
-- last modified by Donahue, 10-Dec-81  9:14:17

DIRECTORY
  Alloc: TYPE USING [Notifier],
  ComData: TYPE USING [
    bodyIndex, catchIndex, globalFrameSize, interface, monitored, stopping,
    switches, textIndex, typeBOOL, typeINT, typeLOCK],
  Log: TYPE USING [Error, ErrorSei, ErrorTree],
  LiteralOps: TYPE USING [Find, ResetLocalStrings],
  P4: TYPE USING [
    Attr, voidAttr, ConsState, Repr, none, unsigned, both, other,
    AdjustBias, Assignment, BiasForType, BoolTest, BoolValue, Call, CheckBlock,
    CommonProp, CommonRep, ConstantInterval, Cover, DeclItem, DeclUpdate,
    Exp, Extract, Interval, LayoutBlock, LayoutGlobals, LayoutInterface, LayoutLocals,
    MakeArgRecord, MakeTreeLiteral, NeutralExp, NormalizeRange,
    OperandType, ProcessSymLiterals, RelTest, RepForType, Rhs, RValue,
    TreeLiteral, TreeLiteralValue, VAttr, VBias, VPop, VProp, VRep, WordsForType,
    EmptyInterval],
  Pass4: TYPE USING [
    implicitAttr, implicitBias, implicitType, lockNode, resident, resumeRecord, returnRecord],
  PrincOps: TYPE USING [StateVector, EPRange, localbase],
  Symbols: TYPE USING [
    Base, ISEIndex, CSEIndex, RecordSEIndex, CTXIndex, BTIndex, CBTIndex, CCBTIndex,
    BodyInfo, ContextLevel, CSENull, ISENull, RecordSENull, CTXNull, RootBti, BTNull,
    lG, lL, typeANY, WordLength, seType, ctxType, bodyType],
  SymbolOps: TYPE USING [
    ArgRecord, Cardinality, ContextVariant, DelinkBti, FirstCtxSe, NextSe, NormalType,
    TransferTypes, TypeLink, UnderType],
  SymLiteralOps: TYPE USING [DescribeRefLits, DescribeTypes],
  Tree: TYPE USING [
    Base, Index, Link, Map, NodeName, Scan, Test, Null, NullIndex, treeType],
  TreeOps: TYPE USING [
    FreeNode, FreeTree, GetNode, GetSe, IdentityMap, ListHead, ListLength, MakeList,
    MakeNode, MarkShared, NthSon, OpName, PopTree, PushProperList, PushList,
    PushLit, PushNode, PushTree, ReverseScanList, ReverseUpdateList, ScanList,
    SearchList, SetAttr, SetInfo, UpdateList];

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

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

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

  Repr: TYPE = P4.Repr;
    none: Repr = P4.none;


 -- bodies and blocks

  currentLevel: PUBLIC ContextLevel;
  currentBody: BTIndex;
  checked: PUBLIC BOOL;

  BodyList: PROC [firstBti: BTIndex] = {
    nextBti: BTIndex;
    FOR bti: BTIndex ← firstBti, nextBti UNTIL bti = BTNull DO
      nextBti ← IF bb[bti].link.which = parent THEN BTNull ELSE bb[bti].link.index;
      WITH bb[bti] SELECT FROM
	Callable =>
	  IF ~inline OR (dataPtr.interface AND LocalBody[LOOPHOLE[bti]]) THEN {
	    IF nesting = Catch THEN BodyList[bb[bti].firstSon]
	    ELSE Body[LOOPHOLE[bti, CBTIndex]]}
	  ELSE DelinkBti[bti];
	ENDCASE => BodyList[bb[bti].firstSon];
      ENDLOOP};

  LocalBody: PROC [bti: CBTIndex] RETURNS [BOOL] = INLINE {
    sei: ISEIndex = bb[bti].id;
    RETURN [sei = ISENull OR ctxb[seb[sei].idCtx].ctxType = simple]};


  Body: PUBLIC PROC [bti: CBTIndex] = {
    oldBodyIndex: CBTIndex = dataPtr.bodyIndex;
    oldLevel: ContextLevel = currentLevel;
    saveChecked: BOOL = checked;
    saveIndex: CARDINAL = dataPtr.textIndex;
    saveCatchScope: BOOL = catchScope;
    saveRecord: RecordSEIndex = passPtr.returnRecord;
    node: Tree.Index = NARROW[bb[bti].info, BodyInfo.Internal].bodyTree;
    sei: CSEIndex = bb[bti].ioType;
    base, bound: CARDINAL;
    initTree: Tree.Link;
    inRecord: RecordSEIndex;
    catchScope ← FALSE;
    dataPtr.bodyIndex ← currentBody ← bti;  dataPtr.textIndex ← bb[bti].sourceIndex;
    currentLevel ← IF bti = RootBti THEN lG ELSE bb[bti].level;
    checked ← tb[node].attr1;
    IF dataPtr.interface AND bb[bti].level > lL
      THEN Log.ErrorSei[nonDefinition, bb[bti].id];
    [inRecord, passPtr.returnRecord] ← TransferTypes[bb[bti].ioType];
    IF ~bb[bti].hints.argUpdated THEN SetImmutable[inRecord, TRUE];
    [] ← LiteralOps.ResetLocalStrings[];
    bb[bti].hints.noStrings ← TRUE;	-- see MarkString, below
    IF tb[node].son[4] # Tree.Null THEN {
      tb[node].son[4] ← Exp[tb[node].son[4], none]; VPop[]};
    tb[node].son[1] ← UpdateList[tb[node].son[1], OpenItem];
    [init: initTree, decls: tb[node].son[2]] ← ScanDecls[tb[node].son[2]];
    IF bti = RootBti THEN {
      fragments: BOOL ←
        (SymLiteralOps.DescribeTypes[].length + SymLiteralOps.DescribeRefLits[].length) # 0;
      dataPtr.globalFrameSize ←
        (LayoutGlobals[bti, dataPtr.stopping, fragments] + (WordLength-1))/WordLength;
      IF bb[bti].type # RecordSENull THEN
        seb[bb[bti].type].length ← dataPtr.globalFrameSize*WordLength;
      ProcessSymLiterals[];
      base ← PrincOps.localbase*WordLength;
      IF dataPtr.monitored AND tb[passPtr.lockNode].attr1 THEN {
	PushTree[tb[passPtr.lockNode].son[2]];
	PushLit[LiteralOps.Find[100000b]];  PushNode[cast, 1];
	SetInfo[dataPtr.typeLOCK];
	PushNode[assign, 2];  SetAttr[1, TRUE];
	initTree ← Prefix[PopTree[], initTree]}}
    ELSE {
      base ← LayoutLocals[bti];
      IF bb[bti].type # RecordSENull THEN seb[bb[bti].type].length ← base;
      IF bb[bti].firstSon # BTNull THEN
        initTree ← Prefix[BodyInitList[bb[bti].firstSon], initTree]};
    IF bb[bti].type # RecordSENull THEN seb[bb[bti].type].mark4 ← TRUE;
    tb[node].son[3] ← UpdateList[tb[node].son[3], Stmt];
    bound ← AssignSubBlocks[bti, base];
    WITH bb[bti].info SELECT FROM
      Internal => {
	frameSize ← (bound + (WordLength-1))/WordLength;
	thread ← LiteralOps.ResetLocalStrings[]};
      ENDCASE;
    bb[bti].resident ← passPtr.resident;
    IF bb[bti].firstSon # BTNull THEN BodyList[bb[bti].firstSon];
    tb[node].son[1] ← ReverseUpdateList[tb[node].son[1], CloseItem];
    tb[node].son[2] ← Prefix[initTree, UpdateList[tb[node].son[2], DeclUpdate]];
    IF dataPtr.interface AND bti = RootBti THEN {
      n: CARDINAL = LayoutInterface[bti];
      WITH t: seb[bb[bti].ioType] SELECT FROM
	definition => t.nGfi ← IF n=0 THEN 1 ELSE (n-1)/PrincOps.EPRange + 1;
	ENDCASE};
    SetImmutable[inRecord, FALSE];
    catchScope ← saveCatchScope;
    currentBody ← dataPtr.bodyIndex ← oldBodyIndex;
    currentLevel ← oldLevel;  checked ← saveChecked;
    dataPtr.textIndex ← saveIndex;  passPtr.returnRecord ← saveRecord};

  MarkString: PUBLIC PROC [local: BOOL] = {
    bb[IF local THEN dataPtr.bodyIndex ELSE RootBti].hints.noStrings ← FALSE};
     
  SetImmutable: PROC [rSei: RecordSEIndex, b: BOOL] = {
    IF rSei # RecordSENull THEN
      FOR sei: ISEIndex ← FirstCtxSe[seb[rSei].fieldCtx], NextSe[sei] UNTIL sei = ISENull DO
        seb[sei].immutable ← b;
        ENDLOOP};


  ScanDecls: PROC [t: Tree.Link] RETURNS [init, decls: Tree.Link] = {
    IF OpName[t] = initlist THEN {
      node: Tree.Index = GetNode[t];
      init ← UpdateList[tb[node].son[1], Stmt];  tb[node].son[1] ← Tree.Null;
      decls ← tb[node].son[2];  tb[node].son[2] ← Tree.Null;
      FreeNode[node]}
    ELSE {init ← Tree.Null; decls ← t};
    ScanList[decls, DeclItem]; RETURN};

  Prefix: PROC [first, rest: Tree.Link] RETURNS [Tree.Link] = {
    SELECT TRUE FROM
      (first = Tree.Null) => RETURN [rest];
      (rest = Tree.Null) => RETURN [first];
      ENDCASE => {PushTree[first]; PushTree[rest]; RETURN [MakeList[2]]}};

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

  AssignSubBlocks: PROC [rootBti: BTIndex, base: CARDINAL] RETURNS [bound: CARDINAL] = {
    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 {
	      length: CARDINAL = AssignBlock[bti, base];
	      bound ← MAX[length, bound]};
	  ENDCASE => NULL;
	IF bb[bti].link.which = parent THEN EXIT;
	bti ← bb[bti].link.index;
	ENDLOOP;
    RETURN};


  Subst: PUBLIC PROC [node: Tree.Index] RETURNS [Tree.Link] = {
    OPEN tb[node];
    saveRecord: RecordSEIndex = passPtr.returnRecord;
    saveChecked: BOOL = checked;
    son[1] ← NeutralExp[son[1]];
    passPtr.returnRecord ← TransferTypes[OperandType[son[1]]].typeOut;
    IF ~attr3 THEN checked ← attr1;
    son[2] ← UpdateList[son[2], Stmt];
    checked ← saveChecked;  passPtr.returnRecord ← saveRecord;
    RETURN [[subtree[index: node]]]};


  Scope: PROC [node: Tree.Index, item: Tree.Map] RETURNS [Tree.Link] = {
    OPEN tb[node];
    bti: BTIndex = info;
    saveIndex: CARDINAL = dataPtr.textIndex;
    oldBodyIndex: BTIndex = currentBody;
    oldLevel: ContextLevel = currentLevel;
    initTree: Tree.Link;
    dataPtr.textIndex ← bb[bti].sourceIndex;
    currentBody ← bti;  currentLevel ← bb[bti].level;
    [init: initTree, decls: son[1]] ← ScanDecls[son[1]];
    IF bb[bti].type # RecordSENull THEN seb[bb[bti].type].mark4 ← TRUE;
    CheckBlock[bti];
    son[2] ← UpdateList[son[2], item];
    son[1] ← Prefix[initTree, UpdateList[son[1], DeclUpdate]];
    IF catchScope THEN catchBound ← MAX[AssignBlock[bti, catchBase], catchBound];
    currentBody ← oldBodyIndex;  currentLevel ← oldLevel;
    dataPtr.textIndex ← saveIndex;
    RETURN [[subtree[index: node]]]};

  AssignBlock: PROC [bti: BTIndex, base: CARDINAL] RETURNS [bound: CARDINAL] = {
    node: Tree.Index;
    newBase: CARDINAL = LayoutBlock[bti, base];
    initTree: Tree.Link = IF bb[bti].firstSon # BTNull
	THEN BodyInitList[bb[bti].firstSon]
	ELSE Tree.Null;
    IF bb[bti].type # RecordSENull THEN seb[bb[bti].type].length ← newBase;
    bound ← AssignSubBlocks[bti, newBase];
    WITH bb[bti].info SELECT FROM
      Internal => {frameSize ← (bound + (WordLength-1))/WordLength; node ← bodyTree};
      ENDCASE => NULL;
    IF initTree # Tree.Null THEN tb[node].son[1] ← Prefix[initTree, tb[node].son[1]];
    RETURN};


 -- main dispatch

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

	    assign => {val ← Assignment[node]; VPop[]};
	    extract => val ← ExtractStmt[node];

	    call, portcall, signal, error, xerror, start, join => {val ← Call[node]; VPop[]};
	    subst => val ← Subst[node];

	    block => {
	      saveChecked: BOOL = checked;
	      checked ← tb[node].attr1;  val ← Scope[node, Stmt];
	      checked ← saveChecked};

	    if => val ← IfStmt[node];
	    case => val ← CaseDriver[node, Stmt, 0];
	    bind =>
	      val ← IF attr3 THEN BindType[node, Stmt] ELSE BindCase[node, case, BindStmt];

	    do => val ← DoStmt[node];

	    return, result => Return[node, passPtr.returnRecord];
	    resume => Return[node, passPtr.resumeRecord];

	    label => {son[1] ← Stmt[son[1]]; son[2] ← UpdateList[son[2], Stmt]};

	    open => {
	      son[1] ← UpdateList[son[1], OpenItem];
	      son[2] ← UpdateList[son[2], Stmt];
	      son[1] ← ReverseUpdateList[son[1], CloseItem]};

	    checked => {
	      saveChecked: BOOL = checked;
	      checked ← attr1;  son[1] ← Stmt[son[1]];
	      checked ← saveChecked};

	    enable => {CatchPhrase[son[1]]; son[2] ← Stmt[son[2]]};
	    catchmark => son[1] ← Stmt[son[1]];

	    lock => {son[1] ← UpdateList[son[1], Stmt]; son[2] ← Exp[son[2], none]; VPop[]};
	    notify, broadcast, unlock => {son[1] ← Exp[son[1], none]; VPop[]};
	    wait => {
	      son[1] ← Exp[son[1], none];  VPop[];
	      son[2] ← Exp[son[2], none];  VPop[];
	      IF nSons > 2 THEN CatchNest[son[3]]};

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

	    dst, lst, lste, lstf => {
	      son[1] ← Exp[son[1], none];
	      IF WordsForType[OperandType[son[1]]] < PrincOps.StateVector.SIZE THEN
	        Log.ErrorTree[sizeClash, son[1]];
	      VPop[]};

	    goto, exit, loop, syserror, reject, continue, retry, stop, null => NULL;
	    free => val ← Free[node];

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

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


 -- extraction

  ExtractStmt: PROC [node: Tree.Index] RETURNS [val: Tree.Link] = {
    subNode: Tree.Index = GetNode[tb[node].son[1]];
    rType: RecordSEIndex = tb[subNode].info;
    IF rType # Symbols.RecordSENull THEN {val ← Extract[node]; VPop[]}
    ELSE {
      val ← Stmt[tb[node].son[2]];  tb[node].son[2] ← Tree.Null;
      WITH val SELECT FROM subtree => tb[index].info ← tb[node].info ENDCASE;
      FreeNode[node]};
    RETURN};


 -- return
 
  Return: PROC [node: Tree.Index, type: RecordSEIndex] = {
    tb[node].son[1] ← IF tb[node].attr3 AND type # RecordSENull
      THEN Rhs[tb[node].son[1], type]
      ELSE MakeArgRecord[type, tb[node].son[1]];
    VPop[]};
      

 -- conditionals

  IfStmt: PROC [node: Tree.Index] RETURNS [val: Tree.Link] = {
    OPEN tb[node];
    son[1] ← BoolValue[son[1]];  VPop[];
    son[2] ← Stmt[son[2]];  son[3] ← Stmt[son[3]];
    IF ~TreeLiteral[son[1]] THEN val ← Tree.Link[subtree[index: node]]
    ELSE {
      IF BoolTest[son[1]] THEN {val ← son[2]; son[2] ← Tree.Null}
      ELSE {val ← son[3]; son[3] ← Tree.Null};
      FreeNode[node]};
    RETURN};

 
  BindStmt: PROC [t: Tree.Link, labelBias: INTEGER] RETURNS [Tree.Link] = {
    node: Tree.Index = GetNode[t];
    RETURN [CaseDriver[GetNode[t], Stmt, labelBias]]};


  -- drivers for processing selections

  BindType: PUBLIC PROC [node: Tree.Index, eval: Tree.Map] RETURNS [Tree.Link] = {
    OPEN tb[node];
    saveType: CSEIndex = passPtr.implicitType;
    saveBias: INTEGER = passPtr.implicitBias;
    saveAttr: Attr = passPtr.implicitAttr;

    Item: Tree.Map = {RETURN [Scope[GetNode[t], eval]]};

    subNode: Tree.Index ← GetNode[son[1]];
    type: CSEIndex = OperandType[tb[subNode].son[2]];
    PushTree[RValue[tb[subNode].son[2], BiasForType[type], RepForType[type]]];
    passPtr.implicitType ← type;
    passPtr.implicitAttr ← VAttr[];  passPtr.implicitBias ← VBias[];  VPop[];
    tb[subNode].son[2] ← Tree.Null;
    PushTree[UpdateList[son[3], Item]];  son[3] ← Tree.Null;
    PushTree[eval[son[4]]];  son[4] ← Tree.Null;
    PushNode[name, 3];  SetInfo[info];  SetAttr[1, attr1];  SetAttr[2, attr2];
    FreeNode[node];
    passPtr.implicitAttr ← saveAttr;  passPtr.implicitBias ← saveBias;
    passPtr.implicitType ← saveType;
    RETURN [PopTree[]]};

  BindCase: PUBLIC PROC [
	node: Tree.Index,
	op: Tree.NodeName,
	eval: PROC [Tree.Link, INTEGER] RETURNS [Tree.Link]]
      RETURNS [val: Tree.Link] = {
    OPEN tb[node];
    labelBias: INTEGER = TagBias[BoundType[son[1]], TestCtx[ListHead[son[3]]]];
    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];  SetAttr[2, FALSE];  SetAttr[3, attr3];
    val ← eval[PopTree[], labelBias];  subNode ← GetNode[val];
    tb[subNode].son[4] ← CloseItem[tb[subNode].son[4]];
    FreeNode[node];
    RETURN};


  BoundType: PROC [base: Tree.Link] RETURNS [CSEIndex] = INLINE {
    RETURN [DerefType[OperandType[NthSon[base, 2]]]]};

  TestCtx: PROC [item: Tree.Link] RETURNS [CTXIndex] = INLINE {
    RETURN [IF item = Tree.Null
      THEN CTXNull
      ELSE seb[GetSe[NthSon[ListHead[NthSon[item, 1]], 2]]].idCtx]};
    
  TagBias: PROC [rType: CSEIndex, testCtx: CTXIndex] RETURNS [INTEGER] = {
    FOR subType: CSEIndex ← rType, UnderType[TypeLink[subType]]
     WHILE subType # CSENull DO
      WITH t: seb[subType] SELECT FROM
        record =>
	  IF t.hints.variant THEN {
	    sei: ISEIndex = ContextVariant[t.fieldCtx];
	    uType: CSEIndex = UnderType[seb[sei].idType];
	    WITH u: seb[uType] SELECT FROM
	      union =>
		IF u.caseCtx = testCtx OR testCtx = CTXNull THEN
		  RETURN [BiasForType[UnderType[seb[u.tagSei].idType]]];
	      ENDCASE};
	ENDCASE => EXIT;
      ENDLOOP;
    ERROR};


  CaseDriver: PUBLIC PROC [node: Tree.Index, selection: Tree.Map, labelBias: INTEGER]
      RETURNS [val: Tree.Link] = {
    OPEN tb[node];
    saveType: CSEIndex = passPtr.implicitType;
    saveBias: INTEGER = passPtr.implicitBias;
    saveAttr: Attr = passPtr.implicitAttr;
    type: CSEIndex = OperandType[son[1]];
    son[1] ← Exp[son[1], none];
    IF attr2 THEN {				-- not bind/bindx
      found: BOOL ← FALSE;
      
      EvalTest: Tree.Map = {
        subNode: Tree.Index = GetNode[t];
        IF tb[subNode].son[1] # Tree.Null THEN ERROR;
        tb[subNode].son[1] ← IdentityMap[tb[node].son[1]];
        v ← BoolValue[t];  VPop[];
        IF BoolTest[v] THEN found ← TRUE;
        RETURN};
        
      TestItem: Tree.Test = {
        subNode: Tree.Index = GetNode[t];
        tb[subNode].son[1] ← UpdateList[tb[subNode].son[1], EvalTest];
        IF found THEN {val ← tb[subNode].son[2]; tb[subNode].son[2] ← Tree.Null};
        RETURN [found]};
        
      SearchList[son[2], TestItem];
      IF ~found THEN {val ← son[3]; son[3] ← Tree.Null};
      FreeNode[node];
      val ← selection[val]}
    ELSE IF type = dataPtr.typeBOOL AND attr1 AND TreeLiteral[son[1]] THEN {

      CaseItem: Tree.Scan = {
	subNode: Tree.Index = GetNode[t];
	started: BOOL;

	PushTest: Tree.Scan = {
	  tNode: Tree.Index = GetNode[t];
	  PushTree[tb[tNode].son[2]];  tb[tNode].son[2] ← Tree.Null;
	  IF ~BoolTest[son[1]] THEN PushNode[not, 1];
	  IF started THEN PushNode[or, 2];
	  started ← TRUE;  RETURN};

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

      son[1] ← AdjustBias[son[1], -VBias[]];  VPop[];
      PushTree[son[3]];  son[3] ← Tree.Null;
      ReverseScanList[son[2], CaseItem];
      FreeNode[node];
      passPtr.implicitAttr ← voidAttr;
      val ← selection[PopTree[]]}
    ELSE {
      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: BOOL;
      multiword: BOOL = WordsForType[type] # 1;
      count: CARDINAL;

      TestExp: Tree.Map = {
        v ← RValue[t, 0, none];
        passPtr.implicitAttr.prop ← CommonProp[passPtr.implicitAttr.prop, VProp[]];
        VPop[]};
        
      SwitchValue: Tree.Map = {
	val: Tree.Link;
	tNode: Tree.Index = GetNode[t];
	val ← tb[tNode].son[2] ← RValue[tb[tNode].son[2], passPtr.implicitBias, rep];
        passPtr.implicitAttr.prop ← CommonProp[passPtr.implicitAttr.prop, VProp[]];
        VPop[];
	IF count = 0 THEN {first ← i; minTree ← maxTree ← val}
	ELSE {
	  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};
	count ← count + 1;
	RETURN [t]};

      passPtr.implicitType ← type;
      passPtr.implicitBias ← VBias[] - labelBias;
      passPtr.implicitAttr ← VAttr[];  rep ← passPtr.implicitAttr.rep;  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], TestExp];
	  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 {
	  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)};
	ENDLOOP;
      IF copying THEN {
	FOR j IN [next .. nSons] DO PushTree[tb[listNode].son[j]] ENDLOOP;
	PushProperList[newSons];  son[2] ← PopTree[]};
      son[3] ← selection[son[3]];
      val ← Tree.Link[subtree[index: node]]};
    passPtr.implicitAttr ← saveAttr;  passPtr.implicitBias ← saveBias;
    passPtr.implicitType ← saveType;
    RETURN};

  -- auxiliary routines for CaseDriver

    SwitchWorthy: PROC [entries, delta: CARDINAL] RETURNS [BOOL] = {
      -- the decision function for using a switch
      RETURN [delta < 77777b AND delta+6 < 3*entries]};

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

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

      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]]};


 -- iterative statements

  DoStmt: PROC [node: Tree.Index] RETURNS [val: Tree.Link] = {
    OPEN tb[node];
    void: BOOL ← FALSE;
    bti: BTIndex ← BTNull;
    IF son[1] # Tree.Null THEN [bti, void] ← ForClause[GetNode[son[1]]];
    IF son[2] # Tree.Null THEN {
      son[2] ← BoolValue[son[2]];
      IF TreeLiteral[son[2]] THEN {
        IF BoolTest[son[2]] THEN son[2] ← FreeTree[son[2]] ELSE void ← TRUE};
      VPop[]};
    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 catchScope AND bti # BTNull THEN
      catchBound ← MAX[AssignBlock[bti, catchBase], catchBound];
    IF ~void THEN val ← [subtree[index: node]]
    ELSE {val ← son[6]; son[6] ← Tree.Null; FreeNode[node]};
    RETURN};

  ForClause: PROC [node: Tree.Index] RETURNS [bti: BTIndex, void: BOOL] = {
    idBias: INTEGER;
    idRep, rep: Repr;
    idType, type1, type2: CSEIndex;
    iNode: Tree.Index;
    range: CARDINAL;
    cs: ConsState ← $first;
    void ← FALSE;  bti ← tb[node].info;
    IF tb[node].son[1] = Tree.Null THEN {
      idType ← dataPtr.typeINT; idBias ← 0; idRep ← both}
    ELSE {
      IF OpName[tb[node].son[1]] = decl THEN {
	subNode: Tree.Index ← GetNode[tb[node].son[1]];
	ScanList[tb[node].son[1], DeclItem];
	tb[node].son[1] ← tb[subNode].son[1];
	tb[subNode].son[1] ← Tree.Null;  FreeNode[subNode];
	cs ← $init};
      idType ← OperandType[tb[node].son[1]];
      tb[node].son[1] ← Exp[tb[node].son[1], none];
      idBias ← VBias[];  idRep ← VRep[]; VPop[]};
    SELECT tb[node].name FROM
      forseq => {
	tb[node].son[2] ← Rhs[tb[node].son[2], idType, cs];      VPop[];
	tb[node].son[3] ← Rhs[tb[node].son[3], idType, $first];  VPop[]};
      upthru, downthru => {
	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]];
	tb[node].attr1 ← Interval[iNode, idBias, idRep].const AND seb[idType].typeTag # long;
	IF tb[node].attr1 AND ~tb[iNode].attr2 THEN
	  [] ← ConstantInterval[iNode ! EmptyInterval => {void ← TRUE; RESUME}];
	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
	  void => NULL;
	  (WordsForType[idType] = 0) => Log.ErrorTree[sizeClash, tb[node].son[1]];
	  (idType # dataPtr.typeINT) AND (idType # typeANY) => {
	    OPEN tb[iNode];
	    range ← Cardinality[idType];
	    IF (checked OR 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.typeINT 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 {	-- nonvoid interval
	      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]]}};
	  ENDCASE};
      ENDCASE => ERROR;
    RETURN};

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


 -- free

  Free: PROC [node: Tree.Index] RETURNS [Tree.Link] = {
    OPEN tb[node];
    vType, pType: CSEIndex;
    IF son[1] # Tree.Null THEN {son[1] ← Exp[son[1], none]; VPop[]};
    son[2] ← NeutralExp[son[2]];
    vType ← OperandType[son[2]];  pType ← DerefType[vType];
    IF OpName[son[2]] = addr THEN {
      subNode: Tree.Index = GetNode[son[2]];
      son[2] ← tb[subNode].son[1];  tb[subNode].son[1] ← Tree.Null;  FreeNode[subNode]}
    ELSE {
      PushTree[son[2]];  PushNode[uparrow, 1];  SetInfo[pType];
      SetAttr[1, checked OR dataPtr.switches['n]];
      SetAttr[2, seb[vType].typeTag = long];
      son[2] ← PopTree[]};
    tb[node].son[3] ← MakeTreeLiteral[WordsForType[DerefType[pType]]];
    IF nSons > 3 THEN CatchNest[son[4]];
    RETURN [[subtree[index: node]]]};


 -- basing

  DerefType: PROC [type: CSEIndex] RETURNS [CSEIndex] = {
    subType: CSEIndex = NormalType[type];
    RETURN [WITH seb[subType] SELECT FROM
      ref => UnderType[refType],
      ENDCASE => type]};

  OpenItem: Tree.Map = {
    node: Tree.Index = GetNode[t];
    IF OpName[tb[node].son[2]] # openx THEN v ← Tree.Null
    ELSE {v ← NeutralExp[tb[node].son[2]]; tb[node].son[2] ← Tree.Null};
    FreeNode[node];
    RETURN};

  CloseItem: Tree.Map = {
    node: Tree.Index;
    IF bb[currentBody].firstSon # BTNull OR OpName[t] # openx THEN v ← t
    ELSE {
      MarkShared[t, FALSE];  node ← GetNode[t];
      v ← tb[node].son[1];  tb[node].son[1] ← Tree.Null;  FreeNode[node]};
    RETURN};


 -- catch phrases

  CatchFrameBase: CARDINAL = (PrincOps.localbase+3)*WordLength;
  catchScope: BOOL;
  catchBase: CARDINAL;
  catchBound: CARDINAL;

  CatchNest: PUBLIC PROC [t: Tree.Link] = {
    IF t # Tree.Null THEN CatchPhrase[t]};

  CatchPhrase: PROC [t: Tree.Link] = {
    node: Tree.Index = GetNode[t];
    saveCatchScope: BOOL = catchScope;
    saveCatchBase: CARDINAL = catchBase;
    saveCatchBound: CARDINAL = catchBound;
    bound: CARDINAL;

    CatchTest: Tree.Map = {
      PushTree[Tree.Null];  PushTree[Exp[t, none]];  VPop[];
      PushNode[relE, 2];  SetInfo[dataPtr.typeBOOL];
      RETURN [PopTree[]]};

    CatchItem: Tree.Scan = {
      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 = CSENull THEN passPtr.resumeRecord ← RecordSENull
      ELSE
	WITH t: seb[type] SELECT FROM
	  transfer => {
	    passPtr.resumeRecord ← ArgRecord[t.typeOut];
	    catchBase ← catchBase +
	      ArgLength[ArgRecord[t.typeIn]] + ArgLength[passPtr.resumeRecord]};
	  ENDCASE => ERROR;
      catchBound ← catchBase;
      tb[node].son[2] ← Stmt[tb[node].son[2]];
      bound ← MAX[bound, catchBound];
      passPtr.resumeRecord ← saveRecord};

    bti: CCBTIndex = tb[node].info;
    bb[bti].index ← dataPtr.catchIndex;  dataPtr.catchIndex ← dataPtr.catchIndex + 1;
    catchScope ← TRUE;  currentLevel ← currentLevel + 1;
    bound ← CatchFrameBase + WordLength;
    ScanList[tb[node].son[1], CatchItem];
    IF tb[node].nSons > 1 THEN {
      catchBound ← catchBase ← CatchFrameBase;
      tb[node].son[2] ← Stmt[tb[node].son[2]];
      bound ← MAX[bound, catchBound]};
    WITH body: bb[bti].info SELECT FROM
      Internal => body.frameSize ← (bound + (WordLength-1))/WordLength;
      ENDCASE => ERROR;
    catchBase ← saveCatchBase;  catchBound ← saveCatchBound;
    currentLevel ← currentLevel - 1;  catchScope ← saveCatchScope};

  ArgLength: PROC [rSei: RecordSEIndex] RETURNS [CARDINAL] = {
    RETURN [IF rSei = RecordSENull THEN 0 ELSE seb[rSei].length]};

  }.