-- Calls.mesa
-- last modified by Sweet, 15-Sep-82 13:49:11
-- last modified by Satterthwaite, May 11, 1983 9:21 am

DIRECTORY
  Alloc: TYPE USING [Notifier],
  Code: TYPE USING [
    CodePassInconsistency, inlineRetErrorLabel, inlineRetErrorListLabel],
  CodeDefs: TYPE USING [
    Base, BoVarIndex, BYTE, CodeCCIndex, codeType, LabelCCIndex, LabelCCNull,
    Lexeme, MaxParmsInStack, NullLex, VarComponent, VarIndex, wordlength],
  ComData: TYPE USING [bodyIndex, stopping],
  Counting: TYPE USING [CheckArgRefs, Free],
  FOpCodes: TYPE USING [
    qAF, qBLT, qCATCH, qDDUP, qEFC, qFF, qGA, qKFCB, qLFC, qLI, qLLOB, 
    qLP, qMR, qMX, qMW, qPI, qPO, qREC, qR, qRDL, qRL, qSELFC, qSFC],
  Log: TYPE USING [Error, Warning],
  OpTableDefs: TYPE USING [InstLength],
  P5: TYPE USING [
    CatchPhrase, Exp, GenTempLex, PushLex, PushRhs, ReleaseLock, 
    SAssign, TransferConstruct],
  P5L: TYPE USING [
    CopyToTemp, CopyVarItem, EasilyLoadable, GenVarItem, LoadAddress,
    LoadComponent, LoadVar, MakeBo, OVarItem, ReleaseLex, ReusableCopies,
    TOSAddrLex, TOSLex, VarForLex, VarVarAssign],
  P5S: TYPE USING [],
  P5U: TYPE USING [
    AllocCodeCCItem, BitsForOperand, BitsForType, ComputeFrameSize,
    CreateLabel, NextVar, 
    OperandType, Out0, Out1, OutJump, PushLitVal,
    TreeLiteralValue, WordsForOperand, WordsForSei],
  PrincOps: TYPE USING [AVHeapSize, returnOffset],
  RTSD: TYPE USING [sProcCheck],
  SDDefs: TYPE USING [
    sCopy, sError, sErrorList, sFork, sJoin, sRestart, sReturnError,
    sReturnErrorList, sSignal, sSignalList, sStart, sUnnamedError],
  Stack: TYPE USING [DeleteToMark, Dump, Incr, Load, Mark, TempStore, Top],
  SDExtra: TYPE USING [sFork12],
  SymbolOps: TYPE USING [
    FindExtension, FirstCtxSe, NextSe, TransferTypes, WordsForType, XferMode],
  Symbols: TYPE USING [
    Base, BitAddress, bodyType, CBTIndex, CBTNull, CCBTIndex, ContextLevel, CSEIndex,
    CTXIndex, ctxType, ISEIndex, lG, RecordSEIndex, SENull, seType],
  Tree: TYPE USING [Base, Index, Link, Null, treeType],
  TreeOps: TYPE USING [FreeNode, GetNode, OpName, NthSon, ScanList, UpdateList];

Calls: PROGRAM
    IMPORTS 
      MPtr: ComData, CPtr: Code, Counting, Log, OpTableDefs,
      P5, P5L, P5U, Stack, SymbolOps, TreeOps 
    EXPORTS CodeDefs, P5, P5S =
  BEGIN
  OPEN CodeDefs;

  -- imported definitions

  BitAddress: TYPE = Symbols.BitAddress;
  CBTIndex: TYPE = Symbols.CBTIndex;
  CCBTIndex: TYPE = Symbols.CCBTIndex;
  CBTNull: CBTIndex = Symbols.CBTNull;
  ContextLevel: TYPE = Symbols.ContextLevel;
  CSEIndex: TYPE = Symbols.CSEIndex;
  CTXIndex: TYPE = Symbols.CTXIndex;
  ISEIndex: TYPE = Symbols.ISEIndex;
  lG: ContextLevel = Symbols.lG;
  RecordSEIndex: TYPE = Symbols.RecordSEIndex;


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

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

  SysError: PUBLIC PROC =
    BEGIN
    Stack.Dump[]; Stack.Mark[];
    SysCall[SDDefs.sUnnamedError];
    P5U.OutJump[JumpRet,LabelCCNull];
    END;


  SysErrExp: PUBLIC PROC [node: Tree.Index] RETURNS [Lexeme] =
    BEGIN
    nrets: CARDINAL = P5U.WordsForSei[tb[node].info];
    Stack.Dump[]; Stack.Mark[];
    SysCall[SDDefs.sUnnamedError];
    P5U.OutJump[JumpRet,LabelCCNull];
    RETURN [PRetLex[nrets, node, TRUE]]
    END;


  Create: PUBLIC PROC [node: Tree.Index] RETURNS [Lexeme] =
    BEGIN -- generate code for NEW
    Stack.Dump[]; Stack.Mark[];
    IF tb[node].attr1 THEN P5.PushRhs[tb[node].son[1]]
    ELSE P5U.Out1[FOpCodes.qGA, 0];
    SysCall[SDDefs.sCopy];
    CallCatch[IF tb[node].nSons > 2 THEN tb[node].son[3] ELSE Tree.Null];
    Stack.Incr[1];
    RETURN [P5L.TOSLex[1]]
    END;


  SStart: PROC [node: Tree.Index] RETURNS [nrets: CARDINAL] =
    BEGIN
    ptsei: CSEIndex = P5U.OperandType[tb[node].son[1]];
    Stack.Dump[]; Stack.Mark[];
    [] _ PushParms[
      argsBuilt: tb[node].attr1, t: tb[node].son[2], ptsei: ptsei, saveOne: TRUE];
    P5.PushRhs[tb[node].son[1]];
    SysCall[SDDefs.sStart];
    CallCatch[IF tb[node].nSons > 2 THEN tb[node].son[3] ELSE Tree.Null];
    RETURN [P5U.WordsForSei[SymbolOps.TransferTypes[ptsei].typeOut]]
    END;

  Start: PUBLIC PROC [node: Tree.Index] = {[] _ SStart[node]};

  StartExp: PUBLIC PROC [node: Tree.Index] RETURNS [Lexeme] =
    BEGIN
    nrets: CARDINAL = SStart[node];
    RETURN [PRetLex[nrets, node, FALSE]]
    END;

  Restart: PUBLIC PROC [node: Tree.Index] =
    BEGIN
    Stack.Dump[]; Stack.Mark[];
    P5.PushRhs[tb[node].son[1]];
    SysCall[SDDefs.sRestart];
    CallCatch[IF tb[node].nSons > 2 THEN tb[node].son[3] ELSE Tree.Null];
    END;


  Stop: PUBLIC PROC [node: Tree.Index]  =
    BEGIN OPEN FOpCodes;
    IF ~MPtr.stopping THEN SIGNAL CPtr.CodePassInconsistency;
    P5U.Out1[qLLOB, PrincOps.returnOffset]; P5U.Out0[qSFC];
    END;


  CallCatch: PUBLIC PROC [t: Tree.Link] =
    BEGIN
    IF t # Tree.Null THEN P5.CatchPhrase[TreeOps.GetNode[t]];
    END;


  SCall: PROC [node: Tree.Index] RETURNS [nrets: CARDINAL] =
    BEGIN -- generates code for procedure call statement
    OPEN FOpCodes;
    ptsei: CSEIndex = P5U.OperandType[tb[node].son[1]];
    portcall: BOOL = (SymbolOps.XferMode[ptsei] = port);
    computedtarget: BOOL;
    nparms: CARDINAL;
    sei: ISEIndex;
    inlineCall: BOOL;
    WITH tb[node].son[1] SELECT FROM
      symbol =>
	BEGIN
	sei _ index;
	inlineCall _ seb[sei].constant AND seb[sei].extended;
	computedtarget _ FALSE;
	END;
      ENDCASE => {inlineCall _ FALSE; computedtarget _ TRUE};
    IF ~inlineCall THEN Stack.Dump[]; 
    Stack.Mark[];
    nparms _ PushParms[
      argsBuilt: tb[node].attr1, 
      t: tb[node].son[2], ptsei: ptsei, saveOne: FALSE, refSafe: ~portcall];
    IF inlineCall THEN 
      BEGIN
      inlineTree: Tree.Link = SymbolOps.FindExtension[sei].tree;
      Stack.DeleteToMark[];
      TreeOps.ScanList[TreeOps.NthSon[inlineTree, 1], CodeInline];
      END 
    ELSE IF computedtarget THEN
      IF portcall THEN 
	BEGIN
	[] _ P5L.LoadAddress[P5L.VarForLex[P5.Exp[tb[node].son[1]]]];
	Stack.DeleteToMark[]; Stack.Incr[1];
	P5U.Out0[qPO]; P5U.Out0[qPI];
	END
      ELSE
	BEGIN
	P5.PushRhs[tb[node].son[1]];
	Stack.DeleteToMark[]; Stack.Incr[1];
	P5U.Out0[qSFC];
	END
    ELSE
      BEGIN
      Stack.DeleteToMark[]; -- assert that loading pdesc won't dump stack
      -- and that it won't need more than two words to load a symbol
      -- the worst case being up level addressing of the indirect word of an uncle
      IF seb[sei].constant THEN 
        BEGIN
	bti: CBTIndex = seb[sei].idInfo;
	IF bti = MPtr.bodyIndex THEN P5U.Out0[qSELFC]
	ELSE IF bti # CBTNull AND bb[bti].nesting = Outer THEN
	  P5U.Out1[qLFC, bb[bti].entryIndex]
        ELSE {P5.PushLex[[se[sei]]]; P5U.Out0[qSFC]};
        END
      ELSE IF portcall THEN
	BEGIN
	[] _ P5L.LoadAddress[P5L.VarForLex[[se[sei]]]];
	P5U.Out0[qPO]; P5U.Out0[qPI];
	END
      ELSE IF seb[sei].linkSpace THEN
	{a: BitAddress = seb[sei].idValue; P5U.Out1[qEFC, a.wd]}
      ELSE {P5.PushLex[[se[sei]]]; P5U.Out0[qSFC]};
      END;
    nrets _ P5U.WordsForSei[SymbolOps.TransferTypes[ptsei].typeOut];
    IF inlineCall THEN 
      {IF tb[node].nSons > 2 THEN P5.CatchPhrase[TreeOps.GetNode[tb[node].son[3]]]}
    ELSE CallCatch[IF tb[node].nSons > 2 THEN tb[node].son[3] ELSE Tree.Null];
    RETURN
    END;

  ConstructOnStack: PUBLIC PROC [maint: Tree.Link, rcsei: RecordSEIndex] =
    BEGIN OPEN SymbolOps;
    ctx: CTXIndex = seb[rcsei].fieldCtx;
    sei: ISEIndex;
    firstArg: BOOL _ TRUE;
    
    DoSafen: PROC [t: Tree.Link] RETURNS [v: Tree.Link] =
      BEGIN
      SELECT TreeOps.OpName[t] FROM
        safen =>
          BEGIN
          node: Tree.Index = TreeOps.GetNode[t];
          IF firstArg OR ~tb[node].attr2 THEN
	    BEGIN -- this dies horribly if there is only a single
		  -- parameter, i.e., no list node, since the call node
		  -- then contains a pointer to the safen which we free
		  -- Therefore, we test below for safen.
	    v _ tb[node].son[1];
	    tb[node].son[1] _ Tree.Null;  TreeOps.FreeNode[node];
	    END
          ELSE
	    BEGIN
	    r: VarIndex = P5L.VarForLex[P5.Exp[tb[node].son[1]]];
	    sei: ISEIndex = P5L.CopyToTemp[r].sei;
	    seb[sei].idType _ tb[node].info;
	    v _ [symbol[sei]];
	    TreeOps.FreeNode[node];
	    END;
	  firstArg _ FALSE;
          END;
        cast, pad =>
          BEGIN
          node: Tree.Index = TreeOps.GetNode[t];
          tb[node].son[1] _ DoSafen[tb[node].son[1]];
          v _ t;
          END;
        ENDCASE =>  -- don't unroll nested constructors
          BEGIN v _ t; firstArg _ FALSE END;
      RETURN
      END;
    
    LoadOne: PROC [t: Tree.Link] =
      BEGIN
      IF t = Tree.Null THEN
	THROUGH [0..SymbolOps.WordsForType[seb[sei].idType]) DO
	  P5U.Out1[FOpCodes.qLI, 0];
	  ENDLOOP
      ELSE IF TreeOps.OpName[t] = pad THEN
	BEGIN
	t1: Tree.Link = TreeOps.NthSon[t, 1];
	delta: CARDINAL = P5U.BitsForType[seb[sei].idType] - P5U.BitsForOperand[t1];
	P5.PushRhs[t1];
	IF delta MOD wordlength # 0 THEN ERROR;
	THROUGH [0.. delta/wordlength) DO P5U.Out1[FOpCodes.qLI, 0] ENDLOOP;
	END
      ELSE P5.PushRhs[t];
      sei _ P5U.NextVar[SymbolOps.NextSe[sei]];
      END;
    
    SELECT TreeOps.OpName[maint] FROM
      list =>
	BEGIN
	maint _ TreeOps.UpdateList[maint, DoSafen];
	sei _ SymbolOps.FirstCtxSe[ctx];
	TreeOps.ScanList[maint, LoadOne];
	END;
      safen => P5.PushRhs[TreeOps.NthSon[maint, 1]];
      ENDCASE => P5.PushRhs[maint];
    END;

  SSigErr: PROC [node: Tree.Index, error: BOOL] RETURNS [nrets: CARDINAL] =
    BEGIN -- generates code for signal/error
    ptsei: CSEIndex = P5U.OperandType[tb[node].son[1]];
    nparms: CARDINAL;
    sysFn: ARRAY BOOL OF ARRAY BOOL OF BYTE = [
      [SDDefs.sSignal, SDDefs.sSignalList],
      [SDDefs.sError, SDDefs.sErrorList]];
    Stack.Dump[]; Stack.Mark[];
    nparms _ PushParms[
      argsBuilt: tb[node].attr1, 
      t: tb[node].son[2], ptsei: ptsei, saveOne: TRUE];
    IF tb[node].son[1] = Tree.Null THEN P5U.PushLitVal[-1]
    ELSE P5.PushRhs[tb[node].son[1]];
    SysCall[sysFn[error][nparms > MaxParmsInStack-1]];
    nrets _ P5U.WordsForSei[SymbolOps.TransferTypes[ptsei].typeOut];
    CallCatch[IF tb[node].nSons > 2 THEN tb[node].son[3] ELSE Tree.Null];
    RETURN
    END;

  RetWithError: PUBLIC PROC [node: Tree.Index] =
    BEGIN -- generates code for RETURN WITH error
    ptsei: CSEIndex = P5U.OperandType[tb[node].son[1]];
    nparms: CARDINAL;
    monitored: BOOL _ tb[node].attr1;
    IF monitored AND tb[node].attr2 THEN {P5.ReleaseLock[]; monitored _ FALSE};
    Stack.Dump[]; Stack.Mark[];
    nparms _ PushParms[
      argsBuilt: FALSE, 
      t: tb[node].son[2], ptsei: ptsei, saveOne: TRUE, refSafe: FALSE];
    IF monitored THEN
      BEGIN
      Stack.Dump[];
      P5.ReleaseLock[];
      IF nparms # 0 THEN Stack.Load[Stack.Top[nparms], nparms];
      END;
    IF tb[node].son[1] = Tree.Null THEN P5U.PushLitVal[-1]
    ELSE P5.PushRhs[tb[node].son[1]];
    IF tb[node].attr3 THEN  -- inline expanded
      BEGIN
      Stack.DeleteToMark[];
      P5U.OutJump[Jump, 
        IF nparms > MaxParmsInStack-1 THEN CPtr.inlineRetErrorListLabel
        ELSE CPtr.inlineRetErrorLabel];
      END
    ELSE SysCall[IF nparms > MaxParmsInStack-1 THEN
      SDDefs.sReturnErrorList ELSE SDDefs.sReturnError];
    P5U.OutJump[JumpRet,LabelCCNull];
    END;

  CodeInline: PROC [t: Tree.Link] =
    BEGIN
    opByte: ARRAY [0..7) OF BYTE;
    iLength: CARDINAL _ 0;
    tLength: CARDINAL;
    c: CodeCCIndex;

    PickUpByte: PROC [t: Tree.Link] =
      BEGIN
      IF iLength < 7 THEN
	BEGIN
	opByte[iLength] _ WITH t SELECT FROM
	  symbol => seb[index].idValue,
	  ENDCASE => P5U.TreeLiteralValue[t];
	iLength _ iLength + 1;
	END
      ELSE Log.Error[instLength];
      END;

    TreeOps.ScanList[t, PickUpByte];
    IF iLength = 0 THEN RETURN;
    tLength _ OpTableDefs.InstLength[opByte[0]];
    IF tLength # 0 AND iLength # tLength THEN Log.Warning[instLength];
    c _ P5U.AllocCodeCCItem[iLength-1];
    cb[c].realinst _ TRUE;
    cb[c].inst _ opByte[0];
    cb[c].isize _ iLength;
    FOR i: CARDINAL IN [1..iLength) DO cb[c].parameters[i] _ opByte[i] ENDLOOP;
    END;


  PushParms: PROC [
        argsBuilt: BOOL, t: Tree.Link, ptsei: CSEIndex, saveOne: BOOL, refSafe: BOOL_TRUE] 
      RETURNS [nparms: CARDINAL] =
    BEGIN
    rsei: RecordSEIndex = SymbolOps.TransferTypes[ptsei].typeIn;
    RETURN [IF argsBuilt
      THEN PushArgRecord[t, rsei, saveOne, refSafe]
      ELSE BuildArgRecord[t, rsei, saveOne, refSafe]]
    END;

  BuildArgRecord: PUBLIC PROC [t: Tree.Link, rsei: RecordSEIndex, sigerr, refSafe: BOOL]
      RETURNS [nparms: CARDINAL] =
    BEGIN
    nparms _ IF rsei = Symbols.SENull THEN 0 ELSE P5U.WordsForSei[rsei];
    IF nparms > MaxParmsInStack OR (sigerr AND nparms > MaxParmsInStack-1) THEN
      BEGIN
      IF ~refSafe AND seb[rsei].hints.refField THEN Log.Warning[unsafeArgs];
      P5.TransferConstruct[nparms, bb[MPtr.bodyIndex].resident, t, rsei];
      END
    ELSE IF nparms # 0 THEN ConstructOnStack[t, rsei];
    RETURN
    END;

  PushArgRecord: PUBLIC PROC [t: Tree.Link, rsei: RecordSEIndex, sigerr, refSafe: BOOL]
      RETURNS [nparms: CARDINAL] =
    BEGIN
    offStack: BOOL;
    frameExists: BOOL _ FALSE;
    nparms _ IF rsei = Symbols.SENull THEN 0 ELSE P5U.WordsForSei[rsei];
    offStack _ (nparms > MaxParmsInStack OR (sigerr AND nparms > MaxParmsInStack-1));
    IF t # Tree.Null THEN
      BEGIN
      l: Lexeme;
      refSafe _ refSafe OR Counting.CheckArgRefs[t, rsei];
      l _ P5.Exp[t ! LogHeapFree => 
	    IF calltree = t AND offStack THEN
	      {frameExists _ TRUE; RESUME [TRUE, NullLex]}
	    ELSE RESUME [FALSE, NullLex] ];
      SELECT TRUE FROM
        frameExists => P5L.ReleaseLex[l];
	offStack =>
	  BEGIN
	  source: VarIndex = P5L.VarForLex[l];
	  dest: VarIndex;
	  temp: VarComponent;
	  fs: CARDINAL _ P5U.ComputeFrameSize[nparms];
	  IF bb[MPtr.bodyIndex].resident THEN
	    fs _ fs + PrincOps.AVHeapSize;
	  IF ~refSafe THEN Log.Warning[unsafeArgs];
	  P5U.PushLitVal[fs];  P5U.Out0[FOpCodes.qAF];
	  temp _ Stack.TempStore[1];
	  dest _ P5L.GenVarItem[bo];
	  cb[dest] _ [body: bo[base: temp, offset: [wSize: nparms, space: frame[]]]];
	  l _ P5L.VarVarAssign[to: dest, from: source, isexp: FALSE];
	  P5L.LoadComponent[temp];
	  END;
	ENDCASE => P5.PushLex[l];
      END;
    RETURN
    END;

  Call: PUBLIC PROC [node: Tree.Index] = {[] _ SCall[node]};

  SigErr: PUBLIC PROC [node: Tree.Index] =
    BEGIN
    error: BOOL = (tb[node].name = error);
    [] _ SSigErr[node, error];
    IF error THEN P5U.OutJump[JumpRet,LabelCCNull];
    END;

  CallExp: PUBLIC PROC [node: Tree.Index] RETURNS [Lexeme] =
    BEGIN
    nrets: CARDINAL = SCall[node];
    RETURN [PRetLex[nrets, node, FALSE]];
    END;

  LogHeapFree: PUBLIC SIGNAL [calltree: Tree.Link] RETURNS [BOOL, Lexeme.se] = CODE;

  IndirectReturnRecord: PUBLIC PROC [node: Tree.Index, nrets: CARDINAL]
      RETURNS [Lexeme] =
    BEGIN -- also called by SubstExp
    OPEN FOpCodes;
    tlex, hlex: Lexeme.se;
    logged: BOOL;
    [logged, hlex] _ SIGNAL LogHeapFree[[subtree[node]]];
    IF ~logged THEN
      BEGIN
      tlex _ P5.GenTempLex[1];
      P5.SAssign[tlex.lexsei];
      P5U.Out0[qREC];
      hlex _ P5.GenTempLex[nrets];
      P5U.PushLitVal[nrets];
      [] _ P5L.LoadAddress[P5L.VarForLex[hlex]];
      P5U.Out0[qBLT];
      P5.PushLex[tlex];
      P5U.Out0[qFF];
      RETURN [hlex]
      END;
    IF hlex # NullLex THEN
      BEGIN
      P5.SAssign[hlex.lexsei]; 
      P5.PushLex[hlex]; -- will become PUSH, helps stack model
      END;
    RETURN [P5L.TOSAddrLex[nrets, FALSE]]
    END;

  SigExp: PUBLIC PROC [node: Tree.Index] RETURNS [Lexeme] =
    BEGIN
    nrets: CARDINAL = SSigErr[node, FALSE];
    RETURN [PRetLex[nrets, node, TRUE]]
    END;

  ErrExp: PUBLIC PROC [node: Tree.Index] RETURNS [Lexeme] =
    BEGIN
    nrets: CARDINAL = P5U.WordsForSei[tb[node].info];
    [] _ SSigErr[node, TRUE];
    P5U.OutJump[JumpRet,LabelCCNull];
    RETURN [PRetLex[nrets, node, TRUE]]
    END;

  SysCall: PUBLIC PROC [alpha: BYTE] =
    BEGIN -- puts out call via system transfer vector
    Stack.DeleteToMark[];
    P5U.Out1[FOpCodes.qKFCB, alpha];
    END;

  SysCallN: PUBLIC PROC [alpha: BYTE, n: CARDINAL] =
    BEGIN -- puts out call via system transfer vector
    Stack.DeleteToMark[];
    P5U.Out1[FOpCodes.qKFCB, alpha];
    Stack.Incr[n];
    END;

  Wait: PUBLIC PROC [node: Tree.Index] =
    BEGIN OPEN FOpCodes;
    retry: LabelCCIndex;
    IF ~P5L.LoadAddress[P5L.VarForLex[P5.Exp[tb[node].son[1]]]] THEN P5U.Out0[qLP];
    IF ~P5L.LoadAddress[P5L.VarForLex[P5.Exp[tb[node].son[2]]]] THEN P5U.Out0[qLP];
    P5U.Out0[qDDUP];
    P5U.Out1[qRL, 1];
    P5U.Out0[qMW];
    retry _ P5U.CreateLabel[];
    IF ~P5L.LoadAddress[P5L.VarForLex[P5.Exp[tb[node].son[1]]]] THEN P5U.Out0[qLP];
    IF ~P5L.LoadAddress[P5L.VarForLex[P5.Exp[tb[node].son[2]]]] THEN P5U.Out0[qLP];
    P5U.Out0[qMR];
    CallCatch[IF tb[node].nSons > 2 THEN tb[node].son[3] ELSE Tree.Null];
    P5U.Out1[FOpCodes.qLI, 0];
    P5U.OutJump[JumpE, retry];
    END;

  ForkExp: PUBLIC PROC [node: Tree.Index] RETURNS [Lexeme] =
    BEGIN
    nparms: CARDINAL;
    ptsei: CSEIndex = P5U.OperandType[tb[node].son[1]];
    Stack.Dump[]; Stack.Mark[];
    nparms _ PushParms[
      argsBuilt: FALSE, t: tb[node].son[2], ptsei: ptsei, saveOne: TRUE, refSafe: FALSE];
    P5.PushRhs[tb[node].son[1]];
    SysCall[IF nparms = MaxParmsInStack THEN SDExtra.sFork12 ELSE SDDefs.sFork];
    IF tb[node].nSons > 2 THEN CallCatch[tb[node].son[3]];
    Stack.Incr[1];
    RETURN [P5L.TOSLex[1]]
    END;

  SJoin: PUBLIC PROC [node: Tree.Index] RETURNS [nrets: CARDINAL] =
    BEGIN
    localcatch: BOOL = (tb[node].nSons > 2);
    cbti: CCBTIndex;
    ptsei: CSEIndex = P5U.OperandType[tb[node].son[1]];
    Stack.Dump[]; Stack.Mark[];
    P5.PushRhs[tb[node].son[1]];
    SysCall[SDDefs.sJoin];
    IF localcatch THEN
      BEGIN
      n3: Tree.Index = TreeOps.GetNode[tb[node].son[3]];
      cbti _ tb[node].info;
      P5.CatchPhrase[n3];
      END;
    Stack.Incr[1];
    P5U.Out0[FOpCodes.qSFC];
    IF localcatch THEN P5U.Out1[FOpCodes.qCATCH, bb[cbti].index];
    RETURN [P5U.WordsForSei[SymbolOps.TransferTypes[ptsei].typeOut]]
    END;

  JoinExp: PUBLIC PROC [node: Tree.Index] RETURNS [Lexeme] =
    BEGIN
    nrets: CARDINAL = SJoin[node];
    RETURN [PRetLex[nrets, node, FALSE]]
    END;

  Join: PUBLIC PROC [node: Tree.Index] = {[] _ SJoin[node]};

  Unlock: PUBLIC PROC [node: Tree.Index] =
    BEGIN
    mlock: Tree.Link = tb[node].son[1];
    IF mlock # Tree.Null THEN
      BEGIN 
      long: BOOL = P5L.LoadAddress[P5L.VarForLex[P5.Exp[mlock]]];
      IF ~long THEN P5U.Out0[FOpCodes.qLP]; 
      P5U.Out0[FOpCodes.qMX]; 
      END;
    END;

  ProcCheck: PUBLIC PROC [node: Tree.Index] RETURNS [Lexeme] =
    BEGIN
    Stack.Dump[]; Stack.Mark[];
    P5.PushRhs[tb[node].son[1]];
    SysCallN[RTSD.sProcCheck, 1];
    RETURN [P5L.TOSLex[1]]
    END;

  PRetLex: PUBLIC PROC [nrets: CARDINAL, node: Tree.Index, sig: BOOL_FALSE]
      RETURNS [Lexeme] =
    BEGIN
    IF nrets > MaxParmsInStack OR (sig AND nrets > MaxParmsInStack-1) THEN
      BEGIN
      Stack.Incr[1];
      RETURN [IndirectReturnRecord[node, nrets]]
      END
    ELSE
      BEGIN
      Stack.Incr[nrets];
      RETURN [P5L.TOSLex[nrets]]
      END
    END;

  Free: PUBLIC PROC [node: Tree.Index] =
    BEGIN
    countedVar: BOOL = tb[node].attr1;
    counted: BOOL = tb[node].attr3;
    zoneLink: Tree.Link = tb[node].son[1];
    varLink: Tree.Link = tb[node].son[2];
    catchLink: Tree.Link = IF tb[node].nSons > 3 THEN tb[node].son[4] ELSE Tree.Null;
    r: VarIndex _ P5L.VarForLex[P5.Exp[varLink]];
    IF counted THEN Counting.Free[r, countedVar, zoneLink, catchLink]
    ELSE
      BEGIN
      rr: VarIndex;
      pLength: CARDINAL = P5U.WordsForOperand[varLink];
      c0: VarIndex _ P5L.OVarItem[[wSize: pLength, space: const[d1:0, d2:0]]];
      long: BOOL = tb[node].attr2;
      bor: BoVarIndex _ P5L.MakeBo[r];
      
      PushVar: PROC =
        BEGIN
	P5L.LoadVar[bor]; [] _ P5L.VarVarAssign[rr, c0, FALSE];
        END;
        
      cb[bor].base _ P5L.EasilyLoadable[cb[bor].base, load];
      rr _ P5L.CopyVarItem[bor];
      ZoneOp[zoneLink, 1, PushVar, catchLink, long];
      END;
    END;

  ZoneOp: PUBLIC PROC [
      zone: Tree.Link, index: CARDINAL, pushArg: PROC, catch: Tree.Link, long: BOOL] =
    BEGIN
    z, zCopy: VarIndex;
    z _ P5L.VarForLex[P5.Exp[zone]];
    [first: z, next: zCopy] _ P5L.ReusableCopies[z, load, FALSE];
    Stack.Dump[];  Stack.Mark[];
    P5L.LoadVar[z];
    pushArg[];
    P5L.LoadVar[zCopy];
    IF long THEN {P5U.Out1[FOpCodes.qRDL, 0]; P5U.Out1[FOpCodes.qRL, index]}
    ELSE {P5U.Out1[FOpCodes.qR, 0]; P5U.Out1[FOpCodes.qR, index]};
    Stack.DeleteToMark[];  Stack.Incr[1];
    P5U.Out0[FOpCodes.qSFC];
    CallCatch[catch];
    END;

  END.