-- Calls.mesa
-- last modified by Sweet, September 18, 1980  2:56 PM
-- last modified by Satterthwaite, March 21, 1983 9:33 am

DIRECTORY
  Alloc: TYPE USING [Notifier],
  Code: TYPE USING [
    actenable, catchcount, cfsi, cfSize, CodePassInconsistency, codeptr, substenable],
  CodeDefs: TYPE USING [
    Base, BoVarIndex, Byte, CodeCCIndex, codeType, LabelCCIndex, LabelCCNull,
    Lexeme, MaxParmsInStack, NullLex, VarComponent, VarIndex],
  ComData: TYPE USING [bodyIndex, stopping, switches],
  Counting: TYPE USING [CheckArgRefs, Free],
  Environment: TYPE USING [bitsPerWord],
  FOpCodes: TYPE USING [
    qALLOC, qBLT, qCATCH, qDUP, qEFC, qFREE, qGADRB, qKFCB, qLFC, qLI, qLL, 
    qLP, qMRE, qMREL, qMXD, qMXDL, qMXW, qMXWL, qPORTI, qPORTO, qPUSH, qR, 
    qRDL, qRL, qSFC],
  Log: TYPE USING [Error, Warning],
  OpTableDefs: TYPE USING [InstLength],
  P5: TYPE USING [
    CatchPhrase, Exp, GenTempLex, PushLex, PushRhs, ReleaseLock, 
    SAssign, SCatchPhrase, TransferConstruct],
  P5L: TYPE USING [
    CopyToTemp, CopyVarItem, EasilyLoadable, GenVarItem, LoadAddress,
    LoadComponent, LoadVar, MakeBo, OVarItem, ReusableCopies, TOSAddrLex,
    TOSLex, ReleaseLex, VarForLex, VarVarAssign],
  P5S: TYPE USING [],
  P5U: TYPE USING [
    AllocCodeCCItem, BitsForOperand, BitsForType, ComputeFrameSize, 
    CreateLabel, InsertLabel, LabelAlloc, LongTreeAddress, NextVar, 
    OperandType, Out0, Out1, OutJump, PushLitVal,
    TreeLiteralValue, WordsForOperand, WordsForSei],
  PrincOps: TYPE USING [AllocationVectorSize, returnOffset],
  RTSD: TYPE USING [sFork, 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],
  SymbolOps: TYPE USING [
    FindExtension, FirstCtxSe, NextSe, TransferTypes, WordsForType, XferMode],
  Symbols: TYPE USING [
    Base, BitAddress, bodyType, CBTIndex, CBTNull, ContextLevel, CSEIndex, 
    CTXIndex, ctxType, ISEIndex, lG, RecordSEIndex, SEIndex, 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

  bitsPerWord: CARDINAL = Environment.bitsPerWord;

  BitAddress: TYPE = Symbols.BitAddress;
  CBTIndex: TYPE = Symbols.CBTIndex;
  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];
    CallCatch[Tree.Null];
    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];
    CallCatch[Tree.Null];
    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.qGADRB, 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[tb[node].attr1, tb[node].son[2], ptsei, FALSE];
    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[qLL, PrincOps.returnOffset]; P5U.Out0[qSFC];
    END;


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

  ChainCatch: PROC [label: LabelCCIndex] =
    BEGIN
    IF label # LabelCCNull THEN
      BEGIN
      clabel: LabelCCIndex = P5U.LabelAlloc[];
      P5U.Out1[FOpCodes.qCATCH, CPtr.cfsi];
      P5U.OutJump[JumpA, clabel];
      P5U.OutJump[Jump, label];
      P5U.InsertLabel[clabel];
      END;
    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 _ ctxb[seb[sei].idCtx].level # lG;
	END;
      ENDCASE => {inlineCall _ FALSE; computedtarget _ TRUE};
    IF ~inlineCall THEN Stack.Dump[]; 
    Stack.Mark[];
    nparms _ PushParms[tb[node].attr1, tb[node].son[2], ptsei, FALSE, ~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[qPORTO]; P5U.Out0[qPORTI];
	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
      IF seb[sei].constant THEN 
        BEGIN
	bti: CBTIndex = seb[sei].idInfo;
	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[qPORTO]; P5U.Out0[qPORTI];
	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 =>  -- dont 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 bitsPerWord # 0 THEN ERROR;
	THROUGH [0.. delta/bitsPerWord) 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[];
    IF tb[node].son[1] = Tree.Null THEN P5U.PushLitVal[-1]
    ELSE P5.PushRhs[tb[node].son[1]];
    nparms _ PushParms[tb[node].attr1, tb[node].son[2], ptsei, TRUE];
    SysCall[sysFn[error][nparms > 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[];
    IF tb[node].son[1] = Tree.Null THEN P5U.PushLitVal[-1]
    ELSE P5.PushRhs[tb[node].son[1]];
    nparms _ PushParms[FALSE, tb[node].son[2], ptsei, TRUE, FALSE];
    IF monitored THEN
      BEGIN
      Stack.Dump[];
      P5.ReleaseLock[];
      Stack.Load[Stack.Top[2],2];
      END;
    IF tb[node].attr3 THEN  -- inline expanded
      BEGIN
      SysCall[IF nparms > 1 THEN SDDefs.sErrorList ELSE SDDefs.sError];
      ChainCatch[CPtr.substenable];
      END
    ELSE SysCall[IF nparms > 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,
        sigerr: BOOL, refSafe: BOOL_TRUE] 
      RETURNS [nparms: CARDINAL] =
    BEGIN
    rsei: RecordSEIndex = SymbolOps.TransferTypes[ptsei].typeIn;
    RETURN [IF argsBuilt
      THEN PushArgRecord[t, rsei, sigerr, FALSE, refSafe]
      ELSE BuildArgRecord[t, rsei, sigerr, FALSE, refSafe]]
    END;

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

  PushArgRecord: PUBLIC PROC [
	t: Tree.Link, rsei: RecordSEIndex, sigerr, isResume, 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 > 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.AllocationVectorSize;
	  IF ~refSafe THEN Log.Warning[unsafeArgs];
	  P5U.PushLitVal[fs];  P5U.Out0[FOpCodes.qALLOC];
	  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
    ELSE IF sigerr AND ~isResume THEN P5U.PushLitVal[-1];
    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[qPUSH];
      hlex _ P5.GenTempLex[nrets];
      P5U.PushLitVal[nrets];
      [] _ P5L.LoadAddress[P5L.VarForLex[hlex]];
      P5U.Out0[qBLT];
      P5.PushLex[tlex];
      P5U.Out0[qFREE];
      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;
    t1Long: BOOL = P5U.LongTreeAddress[tb[node].son[1]];
    t2Long: BOOL = P5U.LongTreeAddress[tb[node].son[2]];
    longWait: BOOL = t1Long OR t2Long;
    [] _ P5L.LoadAddress[P5L.VarForLex[P5.Exp[tb[node].son[1]]]];
    IF ~t1Long AND t2Long THEN P5U.Out0[qLP];
    [] _ P5L.LoadAddress[P5L.VarForLex[P5.Exp[tb[node].son[2]]]];
    IF ~longWait THEN
      BEGIN 
      P5U.Out0[qDUP]; P5U.Out1[qR,1];  -- load timeout 
      P5U.Out0[qMXW];
      END 
    ELSE
      BEGIN
      IF ~t2Long THEN P5U.Out0[qLP];
      [] _ P5L.LoadAddress[P5L.VarForLex[P5.Exp[tb[node].son[2]]]];
      P5U.Out1[IF t2Long THEN qRL ELSE qR, 1];
      P5U.Out0[qMXWL];
      END;
    retry _ P5U.CreateLabel[];
    [] _ P5L.LoadAddress[P5L.VarForLex[P5.Exp[tb[node].son[1]]]];
    IF longWait AND ~t1Long THEN P5U.Out0[qLP];
    [] _ P5L.LoadAddress[P5L.VarForLex[P5.Exp[tb[node].son[2]]]];
    IF longWait AND ~t2Long THEN P5U.Out0[qLP];
    P5U.Out0[IF longWait THEN qMREL ELSE qMRE];
    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
    ptsei: CSEIndex = P5U.OperandType[tb[node].son[1]];
    Stack.Dump[]; Stack.Mark[];
    [] _ PushParms[tb[node].attr1, tb[node].son[2], ptsei, FALSE, FALSE];
    P5.PushRhs[tb[node].son[1]];
    SysCall[IF MPtr.switches['c] THEN RTSD.sFork ELSE SDDefs.sFork];
    CallCatch[IF tb[node].nSons > 2 THEN tb[node].son[3] ELSE Tree.Null];
    Stack.Incr[1];
    RETURN [P5L.TOSLex[1]]
    END;

  SJoin: PUBLIC PROC [node: Tree.Index] RETURNS [nrets: CARDINAL] =
    BEGIN
    ptsei: CSEIndex = P5U.OperandType[tb[node].son[1]];
    Stack.Dump[]; Stack.Mark[];
    P5.PushRhs[tb[node].son[1]];
    SysCall[SDDefs.sJoin];
    IF tb[node].nSons > 2 THEN
      BEGIN
      saveCfSize: CARDINAL = CPtr.cfSize;
      saveCfsi: CARDINAL = CPtr.cfsi;
      cr: CodeCCIndex;
      aroundlabel, firstcatch: LabelCCIndex;
      aroundlabel _ P5U.LabelAlloc[];  firstcatch _ P5U.LabelAlloc[];
      CPtr.catchcount _ CPtr.catchcount + 1;
      P5U.Out1[FOpCodes.qCATCH, 0];
      cr _ LOOPHOLE[CPtr.codeptr, CodeCCIndex];
      P5U.OutJump[JumpA, aroundlabel];
      P5U.InsertLabel[firstcatch];
      P5.SCatchPhrase[TreeOps.GetNode[tb[node].son[3]]];
      cb[cr].parameters[1] _ CPtr.cfsi;
      P5U.InsertLabel[aroundlabel];
      CPtr.catchcount _ CPtr.catchcount - 1;

      Stack.Incr[1];
      P5U.Out0[FOpCodes.qSFC];

      aroundlabel _ P5U.LabelAlloc[];
      P5U.Out1[FOpCodes.qCATCH, CPtr.cfsi];
      P5U.OutJump[JumpA, aroundlabel];
      P5U.OutJump[Jump, firstcatch];
      P5U.InsertLabel[aroundlabel];
      CPtr.cfSize _ saveCfSize;  CPtr.cfsi _ saveCfsi;
      END 
    ELSE
      BEGIN
      CallCatch[Tree.Null];
      Stack.Incr[1];
      P5U.Out0[FOpCodes.qSFC];
      CallCatch[Tree.Null];
      END;
    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]]]; 
      P5U.Out0[IF long THEN FOpCodes.qMXDL ELSE FOpCodes.qMXD]; 
      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 > 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.