-- Statement.mesa, modified by Sweet, November 18, 1979  12:00 AM

DIRECTORY
  AltoDefs: FROM "altodefs" USING [BYTE, wordlength],
  Code: FROM "code" USING [
    actenable, caseCVState, catchcount, catchoutrecord, cfs, 
    CodeNotImplemented, codeptr, curctxlvl, dStar, fileindex, framesz, 
    inlineFileIndex, mwCaseCV, StackNotEmptyAtStatement, xtracting],
  CodeDefs: FROM "codedefs" USING [
    CaseCVState, CCIndex, CCItem, CodeCCIndex, EXLRIndex, JumpCCNull, 
    JumpType, LabelCCIndex, LabelCCNull, Lexeme, NULLfileindex, NullLex, 
    OtherCCIndex, StackIndex, TempStateRecord, VarComponent, VarIndex, 
    VarNull],
  ComData: FROM "comdata" USING [bodyIndex, switches, textIndex],
  ControlDefs: FROM "controldefs" USING [AllocationVectorSize, localbase],
  FOpCodes: FROM "fopcodes" USING [
    qBCAST, qBCASTL, qBNDCK, qCATCH, qDADD, qDCOMP, qDEC, qDST, qDSUB, 
    qDUCOMP, qINC, qLL, qLP, qLST, qLSTF, qNOOP, qNOTIFY, qNOTIFYL, qPUSH, 
    qRET, qSL],
  Log: FROM "log" USING [Error],
  P5: FROM "p5" USING [
    Exp, FlowTree, GenAnonLex, GenHeapLex, GetLabelMark, LabelCreate, 
    LabelList, LogHeapFree, MakeExitLabel, P5Error, PopInVals, PopLabels, 
    PopTempState, PurgeHeapList, PurgePendTempList, PushHeapList, PushLex, 
    PushRhs, PushTempState, ReleaseTempLex, SAssign, SysError, TTAssign],
  P5L: FROM "p5l" USING [
    CopyToTemp, LoadAddress, LoadVar, MakeComponent, NormalizeExp, NormalLex, 
    OVarItem, ReleaseLex, VarForLex],
  P5S: FROM "p5s" USING [
    Assign, Call, CatchMark, Continue, Exit, Extract, GoTo, Join, Label, Lock, 
    Loop, ProcInit, Restart, Result, Resume, Retry, Return, RetWithError, 
    SigErr, Start, Stop, Subst, Unlock, Wait],
  P5U: FROM "p5u" USING [
    CCellAlloc, ComputeFrameSize, CreateLabel, EnumerateCaseArms, FreeChunk, 
    InsertLabel, LabelAlloc, Out0, Out1, OutJump, PushLitVal, TreeLiteral, 
    TreeLiteralValue, WordsForOperand],
  Stack: FROM "stack" USING [
    Clear, Decr, Depth, Dump, Incr, Mark, New, Off, On, Pop, Require, Reset, 
    ResetToMark, Restore, UnMark],
  SymbolOps: FROM "symbolops" USING [WordsForType],
  Symbols: FROM "symbols" USING [
    bodyType, BTIndex, ContextLevel, CTXIndex, CTXNull, ctxType, HTIndex, 
    ISEIndex, ISENull, RecordSEIndex, RecordSENull, SEIndex, SENull, SERecord, 
    seType],
  SymbolSegment: FROM "symbolsegment" USING [ByteIndex],
  SystemDefs: FROM "systemdefs" USING [AllocateHeapNode, FreeHeapNode],
  Table: FROM "table" USING [Base, Limit, Notifier],
  Tree: FROM "tree" USING [Index, Link, NodeName, Null, treeType],
  TreeOps: FROM "treeops" USING [
    FreeTree, ListLength, ReverseUpdateList, ScanList, SetShared, UpdateList];

Statement: PROGRAM
    IMPORTS MPtr: ComData, CPtr: Code, P5U, CodeDefs, P5L, P5, P5S, 
      Stack, SymbolOps, SystemDefs, TreeOps, Log 
    EXPORTS CodeDefs, P5 =
  BEGIN
  OPEN FOpCodes, CodeDefs;


  -- imported definitions

  BYTE: TYPE = AltoDefs.BYTE;
  wordlength: CARDINAL = AltoDefs.wordlength;

  ContextLevel: TYPE = Symbols.ContextLevel;
  CTXIndex: TYPE = Symbols.CTXIndex;
  CTXNull: CTXIndex = Symbols.CTXNull;
  HTIndex: TYPE = Symbols.HTIndex;
  ISEIndex: TYPE = Symbols.ISEIndex;
  ISENull: ISEIndex = Symbols.ISENull;
  RecordSEIndex: TYPE = Symbols.RecordSEIndex;
  RecordSENull: RecordSEIndex = Symbols.RecordSENull;
  SEIndex: TYPE = Symbols.SEIndex;
  SENull: SEIndex = Symbols.SENull;
  SERecord: TYPE = Symbols.SERecord;
  BTIndex: TYPE = Symbols.BTIndex;


  tb: Table.Base;		-- tree base (local copy)
  seb: Table.Base;		-- semantic entry base (local copy)
  ctxb: Table.Base;		-- context entry base (local copy)
  cb: Table.Base;		-- code base (local copy)
  bb: Table.Base;		-- body base (local copy)

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

  CatchFrameTooLarge: SIGNAL = CODE;

  recentStmt: PUBLIC Tree.Link; -- for debugging

  StatementTree: PUBLIC PROCEDURE [t: Tree.Link] RETURNS[Tree.Link] =
    BEGIN -- generates code for Mesa statements
    node: Tree.Index;
    savheaplist: ISEIndex;
    saveIndex: CARDINAL = MPtr.textIndex;

    recentStmt _ t;
    IF t = Tree.Null THEN RETURN[Tree.Null];
    BEGIN
    ENABLE 
      BEGIN
      P5.LogHeapFree => RESUME[TRUE, P5.GenHeapLex[]];
      CPtr.CodeNotImplemented => IF ~MPtr.switches['d] THEN
	GO TO unimplementedConstruct
      END;
    savheaplist _ P5.PushHeapList[];
    WITH t SELECT FROM
      subtree =>
	BEGIN
        fIndex: SymbolSegment.ByteIndex _ CPtr.inlineFileIndex;
	node _ index;
	IF fIndex = NULLfileindex THEN fIndex _ tb[node].info;
	CPtr.fileindex _ MPtr.textIndex _ fIndex;
	IF ~CPtr.xtracting AND Stack.Depth[] # 0 THEN
	  BEGIN SIGNAL CPtr.StackNotEmptyAtStatement; Stack.Clear[]; END;
	SELECT tb[node].name FROM
	  block => Block[node];
	  start => P5S.Start[node];
	  restart => P5S.Restart[node];
	  stop => P5S.Stop[node];
	  dst => DumpState[node];
	  lst => LoadState[node];
	  lstf => LoadStateFree[node];
	  call, portcall => P5S.Call[node];
	  signal,error => P5S.SigErr[node];
	  syserror => P5.SysError[];
	  label => P5S.Label[node];
	  assign => P5S.Assign[node];
	  extract => P5S.Extract[node];
	  if => IfStmt[node];
	  case => [] _ CaseStmtExp[node, FALSE];
	  do => DoStmt[node];
	  exit => P5S.Exit[];
	  loop => P5S.Loop[];
	  retry => P5S.Retry[];
	  continue => P5S.Continue[];
	  goto => P5S.GoTo[node];
	  catchmark => P5S.CatchMark[node];
	  return => P5S.Return[node];
	  resume => P5S.Resume[node];
	  result => P5S.Result[node];
	  open => Open[node];
	  enable => Enable[node];
	  procinit => P5S.ProcInit[node];
	  wait => P5S.Wait[node];
	  notify => Notify[node];
	  broadcast => Broadcast[node];
	  join => P5S.Join[node];
	  unlock => P5S.Unlock[node];
	  lock => P5S.Lock[node];
          subst => P5S.Subst[node];
	  xerror => P5S.RetWithError[node];
	  null => NULL;
	  list => t _ TreeOps.UpdateList[t, StatementTree];
	  ENDCASE => GO TO unimplementedConstruct;
	END;
      ENDCASE;
    P5.PurgeHeapList[savheaplist];
    P5.PurgePendTempList[];
    EXITS
      unimplementedConstruct =>
	BEGIN
	Log.Error[unimplemented];
	Stack.Clear[];
	END;
    END;
    MPtr.textIndex _ saveIndex;
    [] _ TreeOps.FreeTree[t];
    RETURN[Tree.Null]
    END;


  Open: PROCEDURE [node: Tree.Index] =
    BEGIN
    OPEN TreeOps;
    sCopen: PROCEDURE [t: Tree.Link] RETURNS [Tree.Link] =
      BEGIN
      SetShared[t, FALSE];
      RETURN[FreeTree[t]]
      END;

    tb[node].son[2] _ StatementTree[tb[node].son[2]];
    tb[node].son[1] _ ReverseUpdateList[tb[node].son[1], sCopen];
    RETURN
    END;


  DumpState: PROCEDURE [node: Tree.Index] =
    BEGIN -- generates dumpstate
    DLState[node, qDST];
    RETURN
    END;


  LoadState: PROCEDURE [node: Tree.Index] =
    BEGIN -- generates loadstate
    DLState[node, qLST];
    RETURN
    END;


  LoadStateFree: PROCEDURE [node: Tree.Index] =
    BEGIN -- generates loadstateandfree
    DLState[node, qLSTF];
    P5U.OutJump[JumpRet, LabelCCNull];
    RETURN
    END;


  InvalidStateStorageLocation: SIGNAL = CODE;


  DLState: PROCEDURE [node: Tree.Index, opc: BYTE] =
    BEGIN -- does state move after checking for small currentcontext address
    var: VarComponent;

    var _ P5L.MakeComponent[P5L.VarForLex[P5.Exp[tb[node].son[1]]]];
    WITH var SELECT FROM
      frame => IF level = CPtr.curctxlvl AND wd IN BYTE THEN
	BEGIN
	P5U.Out1[opc, wd];
	RETURN
	END;
      ENDCASE;
    SIGNAL InvalidStateStorageLocation;
    END;

  Block: PROCEDURE [node: Tree.Index] =
    BEGIN
    bti: BTIndex _ tb[node].info;
    WITH bb[bti].info SELECT FROM
      Internal => IF CPtr.inlineFileIndex = NULLfileindex THEN
	  CPtr.fileindex _ MPtr.textIndex _ sourceIndex
	ELSE sourceIndex _ CPtr.inlineFileIndex;
      ENDCASE;
    P5U.CCellAlloc[other];
    cb[LOOPHOLE[CPtr.codeptr, OtherCCIndex]].obody _ 
	startbody[index: bti];
    tb[node].son[1] _ TreeOps.UpdateList[tb[node].son[1], StatementTree];
    tb[node].son[2] _ TreeOps.UpdateList[tb[node].son[2], StatementTree];
    P5U.CCellAlloc[other];
    cb[LOOPHOLE[CPtr.codeptr, OtherCCIndex]].obody _ 
	endbody[index: bti];
    END;


  IfStmt: PROCEDURE [node: Tree.Index] =
    BEGIN -- generates code for an IF statement
    ilabel,elabel: LabelCCIndex;

    elabel_P5U.LabelAlloc[];
    P5.FlowTree[tb[node].son[1], FALSE, elabel];
    tb[node].son[2] _ StatementTree[tb[node].son[2]];
    IF tb[node].son[3] # Tree.Null THEN
      BEGIN
      P5U.OutJump[Jump, ilabel_P5U.LabelAlloc[]];
      P5U.InsertLabel[elabel];
      tb[node].son[3] _ StatementTree[tb[node].son[3]];
      P5U.InsertLabel[ilabel];
      END
    ELSE P5U.InsertLabel[elabel];
    RETURN
    END;


  CaseStmtExp: PUBLIC PROCEDURE [node: Tree.Index, iscasexp: BOOLEAN] RETURNS [Lexeme] =
    BEGIN -- generate code for CASE statment and expression
    caseEndLabel: LabelCCIndex _ P5U.LabelAlloc[];
    caseLPEndLabel: LabelCCIndex _ P5U.LabelAlloc[];
    cvSize: CARDINAL _ P5U.WordsForOperand[tb[node].son[1]];
    nwords: CARDINAL _
	IF iscasexp THEN SymbolOps.WordsForType[tb[node].info] ELSE 0;
    savemwCaseCV: Lexeme _ CPtr.mwCaseCV;
    savextracting: BOOLEAN _ CPtr.xtracting;
    savecaseCVState: CaseCVState _ CPtr.caseCVState;
    allConst: BOOLEAN;
    CheckConst: PROCEDURE [t: Tree.Link] =
      BEGIN
      allConst _ allConst AND P5U.TreeLiteral[t];
      END;
    longExpValue: BOOLEAN;
    cvtlex: se Lexeme _ NullLex;
    valTsei: ISEIndex _ ISENull;
    sCitem: PROCEDURE [t: Tree.Link] =
      BEGIN
      faillabel: LabelCCIndex = P5U.LabelAlloc[];
      longx: BOOLEAN _ FALSE;
      r: VarIndex;
      WITH t SELECT FROM
	subtree => [r, valTsei] _ CaseItem[index, iscasexp,
	  FALSE, valTsei, faillabel];
	ENDCASE;
      IF iscasexp THEN 
	BEGIN
	[long: longx, tsei: valTsei] _ P5L.NormalizeExp[r, valTsei, allConst];
	Stack.ResetToMark[];
	END;
      P5U.OutJump[Jump, IF longx THEN caseLPEndLabel ELSE caseEndLabel];
      P5U.InsertLabel[faillabel];
      RETURN
      END;
    cvr: VarIndex;

    CPtr.xtracting _ FALSE;
    IF ~CPtr.dStar THEN Stack.Dump[];
    cvr _ P5L.VarForLex[P5.Exp[tb[node].son[1]]];
    IF iscasexp THEN 
      BEGIN
      Stack.Mark[];
      allConst _ TRUE;
      P5U.EnumerateCaseArms[node, CheckConst];
      END;
    IF cvSize = 1 THEN
      BEGIN
      P5L.LoadVar[cvr];
      CPtr.caseCVState _ singleLoaded;
      END
    ELSE
      BEGIN
      cvtlex _ P5.GenAnonLex[cvSize];
      CPtr.mwCaseCV _
	[bdo[P5L.OVarItem[P5L.CopyToTemp[cvr, cvtlex.lexsei].var]]];
      CPtr.caseCVState _ multi;
      END;
    BEGIN ENABLE 
      P5.LogHeapFree => IF iscasexp THEN RESUME[FALSE, NullLex];
      TreeOps.ScanList[tb[node].son[2], sCitem];
      IF iscasexp THEN
	BEGIN
	r: VarIndex _ P5L.VarForLex[P5.Exp[tb[node].son[3]]];
	long: BOOLEAN _ P5L.NormalizeExp[r, valTsei, allConst].long;
	P5U.OutJump[Jump, IF long THEN caseLPEndLabel ELSE caseEndLabel];
	Stack.UnMark[];
	END
      ELSE tb[node].son[3] _ StatementTree[tb[node].son[3]];
    END;
    P5U.InsertLabel[caseEndLabel];
    longExpValue _ cb[caseLPEndLabel].jumplist # JumpCCNull;
    IF longExpValue THEN P5U.Out0[qLP]; -- unreachable if all arms long
    P5U.InsertLabel[caseLPEndLabel];
    IF cvtlex # NullLex THEN 
      BEGIN
      P5.ReleaseTempLex[cvtlex];
      P5L.ReleaseLex[CPtr.mwCaseCV];
      END;
    IF valTsei # ISENull THEN P5.ReleaseTempLex[[se[valTsei]]];
    CPtr.mwCaseCV _ savemwCaseCV;
    CPtr.caseCVState _ savecaseCVState;
    CPtr.xtracting _ savextracting;
    tb[node].son[1] _ TreeOps.FreeTree[tb[node].son[1]];
    tb[node].son[2] _ TreeOps.FreeTree[tb[node].son[2]];
    tb[node].son[3] _ TreeOps.FreeTree[tb[node].son[3]];
    IF tb[node].nSons > 3 THEN TreeOps.SetShared[tb[node].son[4], FALSE];
    IF iscasexp THEN RETURN [P5L.NormalLex[nwords, longExpValue, allConst]]
    ELSE RETURN [NullLex];
    END;


  NewBranches: PROCEDURE [t: Tree.Link, itemlabel, faillabel: LabelCCIndex,
			bt: DESCRIPTOR FOR ARRAY OF LabelCCIndex]
		RETURNS [new: BOOLEAN] =
    BEGIN -- sees if any new branches need to be added to branch table
    i: CARDINAL;
    snb: PROCEDURE [t: Tree.Link] =
      BEGIN
      i _ P5U.TreeLiteralValue[t];
      IF bt[i] = faillabel THEN
	BEGIN bt[i] _ itemlabel; new _ TRUE; END;
      RETURN
      END;

    new _ FALSE;
    TreeOps.ScanList[t, snb];
    RETURN
    END;


  Branch: PROCEDURE [node: Tree.Index, isexp: BOOLEAN, tempsei: ISEIndex, faillabel: LabelCCIndex] RETURNS [r: VarIndex, tsei: ISEIndex] =
    BEGIN -- generate code for case switch if range is densely packed
    nwords, range, i: CARDINAL;
    btcp, savcodeptr: CCIndex;
    valLabel, valLPLabel: LabelCCIndex;
    bt: DESCRIPTOR FOR ARRAY OF LabelCCIndex;
    first: BOOLEAN _ TRUE;
    allConst: BOOLEAN;
    longExp: BOOLEAN;
    LookForConst: PROCEDURE [t: Tree.Link] =
      BEGIN
      allConst _ allConst AND P5U.TreeLiteral[t];
      END;
    scb: PROCEDURE [t: Tree.Link] =
      BEGIN
      itemlabel: LabelCCIndex;

      WITH t SELECT FROM
	subtree =>
	  BEGIN -- is an item
	  longx: BOOLEAN _ FALSE;
	  bnode: Tree.Index _ index;
	  itemlabel _ P5U.LabelAlloc[];
	  IF NewBranches[tb[bnode].son[1], itemlabel, faillabel, bt] THEN
	    BEGIN
	    P5U.InsertLabel[itemlabel];
	    IF isexp THEN
	      BEGIN
	      longx: BOOLEAN;
	      tr: VarIndex;
	      IF first THEN first _ FALSE ELSE Stack.ResetToMark[];
	      tr _ P5L.VarForLex[P5.Exp[tb[bnode].son[2]]];
	      [nwords: nwords, long: longx, tsei: tsei] _ 
		P5L.NormalizeExp[tr, tsei, allConst];
	      END
	    ELSE tb[bnode].son[2] _ StatementTree[tb[bnode].son[2]];
	    P5U.OutJump[Jump, IF longx THEN valLPLabel ELSE valLabel];
	    END
	  ELSE P5U.FreeChunk[itemlabel, SIZE[label CCItem]];
	  RETURN
	  END;
	ENDCASE
      END;

    tsei _ tempsei;
    IF isexp THEN 
      BEGIN
      allConst _ TRUE;
      TreeOps.ScanList[tb[node].son[3], LookForConst];
      END;
    range _ P5U.TreeLiteralValue[tb[node].son[2]];
    valLabel _ P5U.LabelAlloc[];
    valLPLabel _ P5U.LabelAlloc[];
    IF ~CPtr.dStar THEN
      IF CPtr.caseCVState = singleLoaded THEN Stack.Require[1]
      ELSE Stack.Dump[];
    P5.PushRhs[tb[node].son[1]];
    P5U.PushLitVal[range];
    Stack.Decr[2];
    P5U.CCellAlloc[other];
    cb[LOOPHOLE[CPtr.codeptr, OtherCCIndex]].obody _ 
	table[btab: , tablecodebytes: 3, taboffset: ];
    btcp _ CPtr.codeptr;
    P5U.OutJump[JumpCA, faillabel];
    bt _ DESCRIPTOR[SystemDefs.AllocateHeapNode[range], range];
    FOR i IN [0..range) DO bt[i] _ faillabel ENDLOOP;
    TreeOps.ScanList[tb[node].son[3], scb];
    savcodeptr _ CPtr.codeptr;
    CPtr.codeptr _ btcp;
    FOR i IN [0..range) DO P5U.OutJump[JumpC, bt[i]] ENDLOOP;
    CPtr.codeptr _ savcodeptr;
    P5U.InsertLabel[valLabel];
    longExp _ cb[valLPLabel].jumplist # JumpCCNull;
    IF longExp THEN P5U.Out0[qLP];
    P5U.InsertLabel[valLPLabel];
    SystemDefs.FreeHeapNode[BASE[bt]];
    IF isexp THEN RETURN [
      P5L.VarForLex[P5L.NormalLex[nwords, longExp, allConst]], tsei]
    ELSE RETURN [VarNull, tsei];
    END;


  CaseItem: PROCEDURE [node: Tree.Index, isexp, isenable: BOOLEAN, tempsei: ISEIndex, faillabel: LabelCCIndex] RETURNS [r: VarIndex, tsei: ISEIndex] =
    BEGIN -- generate code for a CASE item
    itemlabel: LabelCCIndex;
    irecord, savcatchoutrecord: RecordSEIndex;
    sei: Table.Base RELATIVE POINTER [0..Table.Limit) TO transfer cons SERecord;
    savinctxlevel, savoutctxlevel: ContextLevel;
    ictx, octx: CTXIndex _ CTXNull;
    lasson: CARDINAL;
    thisson: CARDINAL _ 0;
    sci: PROCEDURE [t: Tree.Link] =
      BEGIN
      IF thisson # lasson THEN
	BEGIN
	P5.FlowTree[t, TRUE, itemlabel];
	thisson _ thisson+1;
	END
      ELSE
	BEGIN
	P5.FlowTree[t, FALSE, faillabel];
	P5U.InsertLabel[itemlabel];
	END;
      RETURN
      END;

    tsei _ tempsei; r _ VarNull;
    IF tb[node].name = caseswitch THEN
      BEGIN
      [r, tsei] _ Branch[node, isexp, tsei, faillabel];
      RETURN
      END;
    WITH t1: tb[node].son[1] SELECT FROM
      subtree =>
	BEGIN
	itemlabel _ P5U.LabelAlloc[];
	IF tb[t1.index].name # list THEN lasson _ 0
	ELSE lasson _ TreeOps.ListLength[t1]-1;
	TreeOps.ScanList[t1, sci];
	END;
      ENDCASE => P5.FlowTree[t1, FALSE, faillabel];
    IF isexp THEN r _ P5L.VarForLex[P5.Exp[tb[node].son[2]]]
    ELSE
      IF isenable THEN
	BEGIN
	savcatchoutrecord _ CPtr.catchoutrecord;
	sei _ tb[node].info;
	IF sei # SENull THEN
	  BEGIN
	  irecord _ seb[sei].inRecord;
	  CPtr.catchoutrecord _ seb[sei].outRecord;
	  IF irecord # RecordSENull THEN
	    BEGIN
	    ictx _ seb[irecord].fieldCtx;
	    savinctxlevel _ ctxb[ictx].level;
	    ctxb[ictx].level _ CPtr.curctxlvl;
	    END;
	  IF CPtr.catchoutrecord # RecordSENull THEN
	    BEGIN
	    octx _ seb[CPtr.catchoutrecord].fieldCtx;
	    savoutctxlevel _ ctxb[octx].level;
	    ctxb[octx].level _ CPtr.curctxlvl;
	    END;
	  END
	ELSE irecord _ CPtr.catchoutrecord _ RecordSENull;
	P5.PopInVals[irecord, TRUE];
	tb[node].son[2] _ StatementTree[tb[node].son[2]];
	IF ictx # CTXNull THEN ctxb[ictx].level _ savinctxlevel;
	IF octx # CTXNull THEN ctxb[octx].level _ savoutctxlevel;
	CPtr.catchoutrecord _ savcatchoutrecord;
	END
      ELSE tb[node].son[2] _ StatementTree[tb[node].son[2]];
    RETURN
    END;


  DoStmt: PROCEDURE [rootnode: Tree.Index] =
    BEGIN --  generates code for all the loop statments
    steploop, tempindex, tempend, uploop, forseqloop, signed, long, bigforseq: BOOLEAN _ FALSE;
    t, Sson, Eson: Tree.Link;
    node, node2: Tree.Index;
    inttype: Tree.NodeName;
    indexlex: se Lexeme;
    endlex: Lexeme;
    toplabel: LabelCCIndex _ P5U.LabelAlloc[];
    startlabel: LabelCCIndex;
    finlabel: LabelCCIndex _ P5U.LabelAlloc[];
    endlabel, looplabel: LabelCCIndex;
    labelmark: EXLRIndex _ P5.GetLabelMark[];
    updateCV: PROCEDURE [loadlong: BOOLEAN] =
      BEGIN
      IF long THEN
        BEGIN
	IF ~CPtr.dStar THEN
	  IF loadlong THEN
	    BEGIN Stack.Dump[]; P5.PushLex[indexlex]; END
          ELSE Stack.Require[2];
	P5U.PushLitVal[1]; P5U.PushLitVal[0];
	P5U.Out0[IF uploop THEN qDADD ELSE qDSUB];
	P5.SAssign[indexlex.lexsei];
	END
      ELSE P5U.Out0[IF uploop THEN qINC ELSE qDEC];
      END;

    -- set up for EXIT clause

    [exit: endlabel, loop: looplabel] _ P5.MakeExitLabel[];
    TreeOps.ScanList[tb[rootnode].son[5], P5.LabelCreate];

    -- handle initialization node

    t _ tb[rootnode].son[1];
    WITH t SELECT FROM
      subtree =>
       IF t # Tree.Null THEN
	BEGIN
	node _ index;
	SELECT tb[node].name FROM
	  forseq =>
	    BEGIN
	    t1: Tree.Link _ tb[node].son[1];
	    t2: Tree.Link _ tb[node].son[2];
	    WITH t1 SELECT FROM
	      symbol => indexlex _ [se[index]];
	      ENDCASE;
	    forseqloop _ TRUE;
	    bigforseq _ P5U.WordsForOperand[t1] > 2;
	    IF bigforseq THEN
	      BEGIN
	      P5.TTAssign[t1, t2];
	      P5U.InsertLabel[toplabel];
	      END
	    ELSE
	      BEGIN
	      P5.PushRhs[t2];
	      P5U.InsertLabel[toplabel];
	      P5.SAssign[indexlex.lexsei];
	      END;
	    END;
	  upthru, downthru =>
	    BEGIN
	    cvBound: Tree.Link = tb[node].son[3];
	    nonempty: BOOLEAN = tb[node].attr1;
	    steploop _ TRUE;
	    uploop _ tb[node].name = upthru;
	    WITH tb[node].son[2] SELECT FROM
	      subtree =>
		BEGIN
		node2 _ index;
		inttype _ tb[node2].name;
		IF tb[node2].attr1 THEN SIGNAL CPtr.CodeNotImplemented;
		long _ tb[node2].attr2;
		signed _ tb[node2].attr3;
		END;
	      ENDCASE;
	    WITH tb[node].son[1] SELECT FROM
	      subtree => -- son1 is empty
		BEGIN
		indexlex _ P5.GenAnonLex[IF long THEN 2 ELSE 1];
		tempindex _ TRUE;
		END;
	      symbol => indexlex _ Lexeme[se[index]];
	      ENDCASE;
	    WITH tb[node].son[2] SELECT FROM
	      subtree =>
		BEGIN
		IF uploop THEN
		  BEGIN Sson _ tb[node2].son[1]; Eson _ tb[node2].son[2]; END
		ELSE
		  BEGIN
		  SELECT inttype FROM
		    intCO => inttype _ intOC;
		    intOC => inttype _ intCO;
		    ENDCASE;
		  Sson _ tb[node2].son[2];
		  Eson _ tb[node2].son[1];
		  END;
		WITH e: Eson SELECT FROM
		  literal =>
		    WITH e.info SELECT FROM
		      word => endlex _
			 Lexeme[literal[word[index]]];
		      ENDCASE => P5.P5Error[769];
		  ENDCASE =>
		    BEGIN
		    P5.PushRhs[e]; tempend _ TRUE;
		    P5.SAssign[
		      (endlex _ P5.GenAnonLex[IF long THEN 2 ELSE 1]).lexsei];
		    END;
		startlabel _ P5U.LabelAlloc[];
		IF long AND ~CPtr.dStar THEN Stack.Dump[];
		P5.PushRhs[Sson];
		IF long THEN P5.SAssign[indexlex.lexsei];
		IF (inttype = intCC OR inttype = intOO) AND ~nonempty THEN
		    BEGIN -- earlier passes check for empty intervals

		    TopTest: ARRAY BOOLEAN OF
		      ARRAY BOOLEAN OF ARRAY BOOLEAN OF JumpType =
			[[[UJumpL,UJumpLE],	-- unsigned, down, closed/open
			[UJumpG,UJumpGE]],	-- unsigned, up, closed/open
			[[JumpL,JumpLE],	-- signed, down, closed/open
			[JumpG,JumpGE]]];	-- signed, up, closed/open

		    IF long THEN BEGIN P5U.Out0[qPUSH]; P5U.Out0[qPUSH] END;
		    P5.PushLex[endlex];
		    IF long THEN
		      BEGIN
		      P5U.Out0[IF signed THEN qDCOMP ELSE qDUCOMP];
		      P5U.PushLitVal[0]
		      END;
		    P5U.OutJump[
		      TopTest[long OR signed][uploop][inttype = intOO],
		      finlabel];
		    IF ~long THEN P5U.Out0[qPUSH];
		    END;
		IF ~long THEN Stack.Decr[1];
		P5U.OutJump[Jump, startlabel];
		P5U.InsertLabel[toplabel];
		IF ~long THEN P5U.Out0[qPUSH];
		SELECT inttype FROM
		  intCC => BEGIN updateCV[TRUE]; P5U.InsertLabel[startlabel]; END;
		  intOC => updateCV[TRUE];
		  intCO, intOO => NULL;
		  ENDCASE;
		IF ~long THEN
		  BEGIN
		  IF cvBound # Tree.Null THEN
		    BEGIN P5.PushRhs[cvBound]; P5U.Out0[FOpCodes.qBNDCK]; END;
		  P5.SAssign[indexlex.lexsei];
		  END;
		END;
	      ENDCASE;
	    END;
	  ENDCASE;
	END
       ELSE P5U.InsertLabel[toplabel];
      ENDCASE;

    -- now the pre-body test

    IF tb[rootnode].son[2] # Tree.Null THEN
      P5.FlowTree[tb[rootnode].son[2], FALSE, finlabel];

    -- ignore the opens

    -- tb[node].son3;

    -- now the body

    tb[rootnode].son[4] _ StatementTree[tb[rootnode].son[4]];

    -- now (update and) test the control variable

    P5U.InsertLabel[looplabel];
    IF steploop THEN
      BEGIN
      IF long AND (inttype = intOC OR inttype = intOO) THEN
	P5U.InsertLabel[startlabel];
      P5.PushLex[indexlex];
      SELECT inttype FROM
	intCC => NULL;
	intCO => BEGIN updateCV[FALSE]; P5U.InsertLabel[startlabel]; END;
	intOC => IF ~long THEN P5U.InsertLabel[startlabel];
	intOO => 
	  BEGIN 
	  IF ~long THEN P5U.InsertLabel[startlabel]; 
	  updateCV[FALSE]; 
	  END;
	ENDCASE;
      IF long THEN SELECT inttype FROM
	intCO, intOO => BEGIN P5U.Out0[qPUSH]; P5U.Out0[qPUSH] END;
	ENDCASE;
      P5.PushLex[endlex];
      IF long THEN
	BEGIN
	P5U.Out0[IF signed THEN qDCOMP ELSE qDUCOMP];
	P5U.PushLitVal[0]
	END;
      P5U.OutJump[
	    IF ~long AND ~signed THEN 
	      IF uploop THEN UJumpL ELSE UJumpG
	    ELSE IF uploop THEN JumpL ELSE JumpG, toplabel];
      P5U.OutJump[Jump, finlabel];
      IF tempend THEN P5.ReleaseTempLex[LOOPHOLE[endlex, se Lexeme]];
      IF tempindex THEN P5.ReleaseTempLex[indexlex];
      END
    ELSE
      BEGIN
      IF forseqloop THEN
	BEGIN
	WITH tb[rootnode].son[1] SELECT FROM
	  subtree => 
	    BEGIN
	    t3: Tree.Link _ tb[index].son[3];
	    IF bigforseq THEN P5.TTAssign[[symbol[indexlex.lexsei]], t3]
	    ELSE P5.PushRhs[t3!
		P5.LogHeapFree => RESUME[FALSE, NullLex]];
	    END;
	  ENDCASE;
	END;
      P5U.OutJump[Jump, toplabel];
      END;
    Stack.Reset[];

    -- now the labelled EXITs

    P5.LabelList[tb[rootnode].son[5], endlabel];
    P5.PopLabels[labelmark];

    -- finally the FINISHED clause

    P5U.InsertLabel[finlabel];
    tb[rootnode].son[6] _ StatementTree[tb[rootnode].son[6]];
    P5U.InsertLabel[endlabel];
    RETURN
    END;


  CatchPhrase: PUBLIC PROCEDURE [node: Tree.Index] =
    BEGIN -- process a catchphrase at procedure call
    aroundlabel: LabelCCIndex _ P5U.LabelAlloc[];
    savcfs: CARDINAL _ CPtr.cfs;
    r: CodeCCIndex;

    CPtr.catchcount _ CPtr.catchcount + 1;
    P5U.Out1[qCATCH, 0];
    r _ LOOPHOLE[CPtr.codeptr, CodeCCIndex];
    P5U.OutJump[JumpA, aroundlabel];
    SCatchPhrase[node];
    cb[r].parameters[1] _ CPtr.cfs;
    P5U.InsertLabel[aroundlabel];
    CPtr.catchcount _ CPtr.catchcount - 1;
    CPtr.cfs _ savcfs;
    RETURN
    END;


  Enable: PROCEDURE [node: Tree.Index] =
    BEGIN -- generate code for an ENABLE
    aroundlabel: LabelCCIndex _ P5U.LabelAlloc[];
    enablelabel: LabelCCIndex;
    savactenable: LabelCCIndex _ CPtr.actenable;
    savcfs: CARDINAL _ CPtr.cfs;

    CPtr.catchcount _ CPtr.catchcount + 1;
    P5U.Out0[FOpCodes.qNOOP]; -- to get a FGT entry on the jump around
    P5U.OutJump[JumpA,aroundlabel];
    enablelabel _ P5U.CreateLabel[];
    WITH tb[node].son[1] SELECT FROM
      subtree => SCatchPhrase[index];
      ENDCASE;
    P5U.InsertLabel[aroundlabel];
    CPtr.actenable _ enablelabel;
    CPtr.catchcount _ CPtr.catchcount -1;
    tb[node].son[2] _ StatementTree[tb[node].son[2]];
    CPtr.actenable _ savactenable;
    CPtr.cfs _ savcfs;
    RETURN
    END;


  SCatchPhrase: PUBLIC PROCEDURE [node: Tree.Index] =
    BEGIN -- main subr for catchphrases and ENABLEs
    saveCaseCVState: CaseCVState = CPtr.caseCVState;
    endlabel: LabelCCIndex _ P5U.LabelAlloc[];
    oldstkptr: StackIndex = Stack.New[];
    msgtemp, sigtemp: se Lexeme;
    saveactenable: LabelCCIndex = CPtr.actenable;
    tempstate: TempStateRecord;
    sscc: PROCEDURE [t: Tree.Link] =
      BEGIN
      fail: LabelCCIndex = P5U.LabelAlloc[];
      WITH t SELECT FROM
	subtree => [] _ CaseItem[
	  node:index, isexp:FALSE, isenable:TRUE,
	  tempsei: ISENull, faillabel: fail];
	ENDCASE;
      P5U.OutJump[Jump, endlabel];
      P5U.InsertLabel[fail];
      RETURN
      END;

    CPtr.curctxlvl _ CPtr.curctxlvl + 1;
    P5.PushTempState[@tempstate, tb[node].info];
    Stack.Incr[1]; -- signal code is on stack
    IF CPtr.actenable # LabelCCNull THEN
      BEGIN
      sigtemp _ P5.GenAnonLex[1];
      msgtemp _ P5.GenAnonLex[1];
      P5U.Out1[qLL,ControlDefs.localbase+1];
      P5.SAssign[msgtemp.lexsei];
      P5.SAssign[sigtemp.lexsei];
      P5.PushLex[sigtemp];
      END;
    CPtr.caseCVState _ singleLoaded;
    CPtr.actenable _ LabelCCNull;
    TreeOps.ScanList[tb[node].son[1], sscc];
    IF tb[node].son[1] = Tree.Null THEN Stack.Pop[];
    IF tb[node].son[2] # Tree.Null THEN
      tb[node].son[2] _ StatementTree[tb[node].son[2]];
    CPtr.actenable _ saveactenable;
    P5U.InsertLabel[endlabel];
    Stack.Off[];
    IF CPtr.actenable # LabelCCNull THEN
      BEGIN
      P5.PushLex[sigtemp];
      P5.PushLex[msgtemp];
      P5U.Out1[qSL,ControlDefs.localbase+1];
      P5U.OutJump[Jump,CPtr.actenable];
      P5.ReleaseTempLex[msgtemp];
      P5.ReleaseTempLex[sigtemp];
      END
    ELSE
      BEGIN
      P5U.PushLitVal[0];
      P5U.Out0[qRET];
      P5U.OutJump[JumpRet,LabelCCNull];
      END;
    Stack.On[];
    CPtr.curctxlvl _ CPtr.curctxlvl-1;
    CPtr.caseCVState _ saveCaseCVState;
    BEGIN
    fs: CARDINAL _ CPtr.framesz;
    P5.PopTempState[@tempstate];
    CPtr.cfs _ P5U.ComputeFrameSize[fs];
    END;
    IF bb[MPtr.bodyIndex].resident THEN
      CPtr.cfs _ CPtr.cfs+ControlDefs.AllocationVectorSize;
    Stack.Restore[oldstkptr];
    RETURN
    END;

  Notify: PROCEDURE [node: Tree.Index] =
    BEGIN
    r: VarIndex = P5L.VarForLex[P5.Exp[tb[node].son[1]]];
    P5U.Out0[IF P5L.LoadAddress[r].long THEN qNOTIFYL 
	ELSE qNOTIFY];
    END;

  Broadcast: PROCEDURE [node: Tree.Index] =
    BEGIN
    r: VarIndex = P5L.VarForLex[P5.Exp[tb[node].son[1]]];
    P5U.Out0[IF P5L.LoadAddress[r].long THEN qBCASTL
	ELSE qBCAST];
    END;

  END..