-- Calls.mesa, modified by Sweet, January 15, 1980  1:37 PM

DIRECTORY
  AltoDefs: FROM "altodefs" USING [BYTE, wordlength],
  Code: FROM "code" USING [
    actenable, catchcount, cfs, CodePassInconsistency, codeptr, fileindex],
  CodeDefs: FROM "codedefs" USING [
    CodeCCIndex, LabelCCIndex, LabelCCNull, Lexeme, MaxParmsInStack, NullLex, 
    VarComponent, VarIndex],
  ComData: FROM "comdata" USING [bodyIndex, stopping],
  ControlDefs: FROM "controldefs" USING [AllocationVectorSize, returnOffset],
  FOpCodes: FROM "fopcodes" USING [
    qALLOC, qBLT, qCATCH, qDUP, qEFC, qFREE, qGADRB, qKFCB, qLFC, qLI, qLL, 
    qLP, qMRE, qMREL, qMXD, qMXDL, qMXW, qMXWL, qPORTI, qPORTO, qPUSH, qR, 
    qRL, qSFC],
  Literals: FROM "literals" USING [STIndex],
  Log: FROM "log" USING [Error, Warning],
  OpTableDefs: FROM "optabledefs" USING [instlength],
  P5: FROM "p5" USING [
    CatchPhrase, Exp, GenTempLex, P5Error, PushLex, PushRhs, ReleaseLock, 
    SAssign, SCatchPhrase, TransferConstruct],
  P5L: FROM "p5l" USING [
    AddrForVar, CopyToTemp, EasilyLoadable, LoadAddress, LoadComponent, 
    TOSAddrLex, TOSLex, VarForLex],
  P5S: FROM "p5s",
  P5U: FROM "p5u" USING [
    AllocCodeCCItem, BitsForOperand, BitsForType, ComputeFrameSize, 
    CreateLabel, InsertLabel, LabelAlloc, LongTreeAddress, NextVar, 
    OperandType, Out0, Out1, OutJump, PushLitVal, SetCodeIndex, 
    TreeLiteralValue, WordsForSei],
  SDDefs: FROM "sddefs" USING [
    sCopy, sError, sErrorList, sFork, sJoin, sRestart, sReturnError, 
    sReturnErrorList, sSignal, sSignalList, sStart, sUnnamedError],
  Stack: FROM "stack" USING [DeleteToMark, Dump, Incr, Load, Mark, Top],
  SymbolOps: FROM "symbolops" USING [
    FindExtension, FirstCtxSe, NextSe, UnderType, WordsForType, XferMode],
  Symbols: FROM "symbols" USING [
    BitAddress, bodyType, BTIndex, BTNull, CBTIndex, ContextLevel, CSEIndex, 
    CTXIndex, ctxType, HTIndex, ISEIndex, lG, MDIndex, RecordSEIndex, SEIndex, 
    SENull, SERecord, seType, TypeClass],
  Table: FROM "table" USING [Base, Notifier],
  Tree: FROM "tree" USING [Index, Link, Null, treeType],
  TreeOps: FROM "treeops" USING [FreeNode, ScanList, UpdateList];

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

  -- imported definitions

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

  sStart: BYTE = SDDefs.sStart;
  sRestart: BYTE = SDDefs.sRestart;
  sFork: BYTE = SDDefs.sFork;
  sJoin: BYTE = SDDefs.sJoin;

  STIndex: TYPE = Literals.STIndex;

  BitAddress: TYPE = Symbols.BitAddress;
  BTIndex: TYPE = Symbols.BTIndex;
  CBTIndex: TYPE = Symbols.CBTIndex;
  BTNull: BTIndex = Symbols.BTNull;
  ContextLevel: TYPE = Symbols.ContextLevel;
  CSEIndex: TYPE = Symbols.CSEIndex;
  CTXIndex: TYPE = Symbols.CTXIndex;
  HTIndex: TYPE = Symbols.HTIndex;
  ISEIndex: TYPE = Symbols.ISEIndex;
  MDIndex: TYPE = Symbols.MDIndex;
  lG: ContextLevel = Symbols.lG;
  RecordSEIndex: TYPE = Symbols.RecordSEIndex;
  SEIndex: TYPE = Symbols.SEIndex;
  SERecord: TYPE = Symbols.SERecord;
  TypeClass: TYPE = Symbols.TypeClass;


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

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

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


  SysErrExp: PUBLIC PROCEDURE [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;


  New: PUBLIC PROCEDURE [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 = 3 THEN tb[node].son[3] ELSE Tree.Null];
    Stack.Incr[1];
    RETURN[P5L.TOSLex[1]]
    END;


  SStart: PROCEDURE [node: Tree.Index] RETURNS [nrets: CARDINAL] =
    BEGIN
    OPEN FOpCodes;
    ptsei: CSEIndex _ P5U.OperandType[tb[node].son[1]];
    Stack.Dump[]; Stack.Mark[];
    [] _ PushParms[tb[node].son[2], ptsei, FALSE];
    P5.PushRhs[tb[node].son[1]];
    SysCall[sStart];
    CallCatch[IF tb[node].nSons = 3 THEN tb[node].son[3] ELSE Tree.Null];
    WITH seb[ptsei] SELECT FROM
      transfer => nrets _ P5U.WordsForSei[outRecord];
      ENDCASE;
    RETURN
    END;

  Start: PUBLIC PROCEDURE [node: Tree.Index] =
    BEGIN
    [] _ SStart[node];
    RETURN
    END;

  StartExp: PUBLIC PROCEDURE [node: Tree.Index] RETURNS [Lexeme] =
    BEGIN
    nrets: CARDINAL _ SStart[node];

    RETURN [PRetLex[nrets, node, FALSE]];
    END;

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


  Stop: PUBLIC PROCEDURE [node: Tree.Index] =
    BEGIN OPEN FOpCodes;
    IF ~MPtr.stopping THEN SIGNAL CPtr.CodePassInconsistency;
    P5U.Out1[qLL, ControlDefs.returnOffset]; P5U.Out0[qSFC];
    CallCatch[IF tb[node].nSons = 1 THEN tb[node].son[1] ELSE Tree.Null];
    RETURN
    END;


  CallCatch: PROCEDURE [t: Tree.Link] =
    BEGIN
    clabel: LabelCCIndex;

    WITH t SELECT FROM
      subtree =>
	IF t # Tree.Null THEN P5.CatchPhrase[index]
	ELSE
	  IF CPtr.actenable # LabelCCNull THEN
	    BEGIN
	    clabel _ P5U.LabelAlloc[];
	    P5U.Out1[FOpCodes.qCATCH, CPtr.cfs];
	    P5U.OutJump[JumpA, clabel];
	    P5U.OutJump[Jump, CPtr.actenable];
	    P5U.InsertLabel[clabel];
	    END;
      ENDCASE;
    RETURN
    END;


  SCall: PROCEDURE [node: Tree.Index] RETURNS [nrets: CARDINAL] =
    BEGIN -- generates code for procedure call statement
    OPEN FOpCodes;
    ptsei: CSEIndex _ P5U.OperandType[tb[node].son[1]];
    portcall: BOOLEAN _ SymbolOps.XferMode[ptsei] = port;
    computedtarget: BOOLEAN;
    inlineTree: Tree.Link;
    nparms: CARDINAL;
    sei: ISEIndex;
    bti: CBTIndex;
    a: BitAddress;
    inlineCall: BOOLEAN;

    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 => 
	BEGIN
	inlineCall _ FALSE;
	computedtarget _ TRUE;
	END;
    IF ~inlineCall THEN Stack.Dump[]; 
    Stack.Mark[];
    nparms _ PushParms[tb[node].son[2], ptsei, FALSE];
    IF inlineCall THEN 
      BEGIN
      Stack.DeleteToMark[];
      inlineTree _ SymbolOps.FindExtension[sei].tree;
      WITH inlineTree SELECT FROM
        subtree => TreeOps.ScanList[tb[index].son[1], CodeInline];
        ENDCASE => P5.P5Error[513];
      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 _ seb[sei].idInfo;
	IF bti # BTNull AND bb[bti].nesting = Outer THEN
	  P5U.Out1[qLFC, bb[bti].entryIndex]
        ELSE
	  BEGIN
	  P5.PushLex[[se[sei]]];
	  P5U.Out0[qSFC];
	  END;
        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
	BEGIN a _ seb[sei].idValue; P5U.Out1[qEFC, a.wd]; END
      ELSE BEGIN P5.PushLex[[se[sei]]]; P5U.Out0[qSFC] END;
      END;
    WITH seb[ptsei] SELECT FROM
      transfer => nrets _ P5U.WordsForSei[outRecord];
      ENDCASE => P5.P5Error[514];
    IF inlineCall THEN 
      BEGIN
      IF tb[node].nSons = 3 THEN
        WITH tb[node].son[3] SELECT FROM
          subtree => P5.CatchPhrase[index];
          ENDCASE;
      END
    ELSE CallCatch[IF tb[node].nSons = 3 THEN tb[node].son[3] ELSE Tree.Null];
    RETURN
    END;

  ConstructOnStack: PUBLIC PROCEDURE [maint: Tree.Link, rcsei: RecordSEIndex] =
    BEGIN OPEN SymbolOps;
    ctx: CTXIndex = seb[rcsei].fieldCtx;
    sei: ISEIndex;
    
    DoSafen: PROCEDURE [t: Tree.Link] RETURNS [Tree.Link] =
      BEGIN
      WITH t SELECT FROM
	subtree => 
	  BEGIN
	  node: Tree.Index = index;
	  SELECT tb[index].name FROM
	    safen =>
	      BEGIN
	      r: VarIndex = P5L.VarForLex[P5.Exp[tb[index].son[1]]];
	      sei: ISEIndex = P5L.CopyToTemp[r].sei;
	      seb[sei].idType _ tb[node].info;
	      TreeOps.FreeNode[node];
	      RETURN [[symbol[sei]]];
	      END;
	    cast, pad =>
	      tb[node].son[1] _ TreeOps.UpdateList[tb[node].son[1], DoSafen];
	    ENDCASE; -- dont unroll nested constructors
	  END;
	ENDCASE;
      RETURN[t];
      END;
    
    LoadOne: PROCEDURE [t: Tree.Link] =
      BEGIN
      WITH t SELECT FROM
        subtree =>
	  BEGIN
	  IF t = Tree.Null THEN
	    BEGIN
	    THROUGH [0..SymbolOps.WordsForType[seb[sei].idType]) DO
	      P5U.Out1[FOpCodes.qLI, 0];
	      ENDLOOP;
	    END
          ELSE SELECT tb[index].name FROM
	    pad =>
	      BEGIN
	      delta: CARDINAL;
	      t1: Tree.Link = tb[index].son[1];
	      delta _
		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;
	    ENDCASE => P5.PushRhs[t];
	  END;
	ENDCASE => P5.PushRhs[t];
      sei _ P5U.NextVar[SymbolOps.NextSe[sei]];
      END;
    
    maint _ TreeOps.UpdateList[maint, DoSafen];
    sei _ SymbolOps.FirstCtxSe[ctx];
    TreeOps.ScanList[maint, LoadOne];
    END;

  SSigErr: PROCEDURE [node: Tree.Index, error: BOOLEAN] RETURNS [nrets: CARDINAL] =
    BEGIN -- generates code for signal/error
    ptsei: CSEIndex _ P5U.OperandType[tb[node].son[1]];
    nparms: CARDINAL;
    sysFn: ARRAY BOOLEAN OF ARRAY BOOLEAN 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].son[2], ptsei, TRUE];
    SysCall[sysFn[error][nparms > 1]];
    WITH seb[ptsei] SELECT FROM
      transfer => nrets _ P5U.WordsForSei[outRecord];
      ENDCASE;
    CallCatch[IF tb[node].nSons = 3 THEN tb[node].son[3] ELSE Tree.Null];
    RETURN
    END;

  RetWithError: PUBLIC PROCEDURE [node: Tree.Index] =
    BEGIN -- generates code for RETURN WITH error
    ptsei: CSEIndex _ P5U.OperandType[tb[node].son[1]];
    nparms: CARDINAL;
    monitored: BOOLEAN _ tb[node].attr1;

    IF monitored AND tb[node].attr2 THEN
      BEGIN P5.ReleaseLock[]; monitored _ FALSE END;
    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].son[2], ptsei, TRUE];
    IF monitored THEN
      BEGIN
      Stack.Dump[];
      P5.ReleaseLock[];
      Stack.Load[Stack.Top[2],2];
      END;
    SysCall[IF nparms > 1 THEN SDDefs.sReturnErrorList 
		ELSE SDDefs.sReturnError];
    P5U.OutJump[JumpRet,LabelCCNull];
    RETURN
    END;

  CodeInline: PROCEDURE [t: Tree.Link] =
    BEGIN
    opByte: ARRAY [0..3] OF BYTE;
    iLength: CARDINAL _ 0;
    tLength: CARDINAL;
    i: CARDINAL;
    c: CodeCCIndex;

    PickUpByte: PROCEDURE [t: Tree.Link] =
      BEGIN
      opByte[iLength] _ WITH t SELECT FROM
	symbol => seb[index].idValue,
	ENDCASE => P5U.TreeLiteralValue[t];
      IF (iLength _ iLength+1) > 3 THEN 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];
    P5U.SetCodeIndex[CPtr.fileindex];
    c _ P5U.AllocCodeCCItem[iLength-1];
    cb[c].realinst _ TRUE;
    cb[c].inst _ opByte[0];
    cb[c].isize _ iLength;
    FOR i IN [1..iLength) DO cb[c].parameters[i] _ opByte[i]; ENDLOOP;
    END;


  PushParms: PROCEDURE [t: Tree.Link, ptsei: CSEIndex, sigerr: BOOLEAN] 
      RETURNS [nparms: CARDINAL] =
    BEGIN
    rsei: RecordSEIndex;

    WITH seb[ptsei] SELECT FROM
      transfer => rsei _ LOOPHOLE[SymbolOps.UnderType[inRecord]];
      ENDCASE => P5.P5Error[515];
    RETURN [BuildArgRecord[t, rsei, sigerr]];
    END;

  BuildArgRecord: PUBLIC PROCEDURE [
    t: Tree.Link, rsei: RecordSEIndex, sigerr, isResume: BOOLEAN _ FALSE]
      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
      fs: CARDINAL _ P5U.ComputeFrameSize[nparms];
      IF bb[MPtr.bodyIndex].resident THEN
        fs _ fs+ControlDefs.AllocationVectorSize;
      P5U.PushLitVal[fs];
      P5U.Out0[FOpCodes.qALLOC];
      P5.TransferConstruct[P5L.TOSAddrLex[nparms], 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;

  Call: PUBLIC PROCEDURE [node: Tree.Index] =
    BEGIN
    [] _ SCall[node];
    RETURN
    END;

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

  CallExp: PUBLIC PROCEDURE [node: Tree.Index] RETURNS [Lexeme] =
    BEGIN
    nrets: CARDINAL _ SCall[node];

    RETURN[PRetLex[nrets, node, FALSE]];
    END;

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

  IndirectReturnRecord: PUBLIC PROCEDURE [node: Tree.Index, nrets: CARDINAL] RETURNS[Lexeme] =
    BEGIN -- also called by SubstExp
    OPEN FOpCodes;
    tlex, hlex: se Lexeme;
    logged: BOOLEAN;

    [logged, hlex] _ SIGNAL LogHeapFree[Tree.Link[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]; P5U.Out0[qPUSH]; END;
    RETURN [P5L.TOSAddrLex[nrets, FALSE]]
    END;

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

  ErrExp: PUBLIC PROCEDURE [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 PROCEDURE [alpha: BYTE] =
    BEGIN -- puts out call via system transfer vector
    Stack.DeleteToMark[];
    P5U.Out1[FOpCodes.qKFCB, alpha];
    RETURN
    END;

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

  Wait: PUBLIC PROCEDURE [node: Tree.Index] =
    BEGIN OPEN FOpCodes;
    retry: LabelCCIndex;
    t1Long: BOOLEAN _ P5U.LongTreeAddress[tb[node].son[1]];
    t2Long: BOOLEAN _ P5U.LongTreeAddress[tb[node].son[2]];
    longWait: BOOLEAN;
    t1avar, t2avar: VarComponent;
    t1avar _ P5L.AddrForVar[P5L.VarForLex[P5.Exp[tb[node].son[1]]]];
    t1avar _ P5L.EasilyLoadable[t1avar, store];
    P5L.LoadComponent[t1avar];
    IF ~t1Long AND t2Long THEN P5U.Out0[qLP];
    t2avar _ P5L.AddrForVar[P5L.VarForLex[P5.Exp[tb[node].son[2]]]];
    t2avar _ P5L.EasilyLoadable[t2avar, store];
    P5L.LoadComponent[t2avar];
    longWait _ t1Long OR t2Long;
    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.LoadComponent[t2avar]; -- since DUP doesn't work well for longs
      P5U.Out1[IF t2Long THEN qRL ELSE qR, 1];
      P5U.Out0[qMXWL];
      END;
    retry _ P5U.CreateLabel[];
    P5L.LoadComponent[t1avar];
    IF longWait AND ~t1Long THEN P5U.Out0[qLP];
    P5L.LoadComponent[t2avar];
    IF longWait AND ~t2Long THEN P5U.Out0[qLP];
    P5U.Out0[IF longWait THEN qMREL ELSE qMRE];
    CallCatch[IF tb[node].nSons = 3 THEN tb[node].son[3] ELSE Tree.Null];
    P5U.Out1[FOpCodes.qLI, 0];
    P5U.OutJump[JumpE, retry];
    END;

  ForkExp: PUBLIC PROCEDURE [node: Tree.Index] RETURNS [Lexeme] =
    BEGIN
    ptsei: CSEIndex _ P5U.OperandType[tb[node].son[1]];
    Stack.Dump[]; Stack.Mark[];
    [] _ PushParms[tb[node].son[2], ptsei, FALSE];
    P5.PushRhs[tb[node].son[1]];
    SysCall[sFork];
    CallCatch[IF tb[node].nSons = 3 THEN tb[node].son[3] ELSE Tree.Null];
    Stack.Incr[1];
    RETURN [P5L.TOSLex[1]];
    END;

  SJoin: PUBLIC PROCEDURE [node: Tree.Index] RETURNS [nrets: CARDINAL] =
    BEGIN
    localcatch: BOOLEAN _ tb[node].nSons = 3;
    ptsei: CSEIndex _ P5U.OperandType[tb[node].son[1]];
    aroundlabel, firstcatch: LabelCCIndex;
    savcfs: CARDINAL _ CPtr.cfs;
    Stack.Dump[]; Stack.Mark[];
    P5.PushRhs[tb[node].son[1]];
    SysCall[sJoin];
    IF localcatch THEN
      BEGIN
      cr: CodeCCIndex;
      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];
      WITH tb[node].son[3] SELECT FROM
	subtree => P5.SCatchPhrase[index];
	ENDCASE => P5.P5Error[516];
      cb[cr].parameters[1] _ CPtr.cfs;
      P5U.InsertLabel[aroundlabel];
      CPtr.catchcount _ CPtr.catchcount - 1;
      END 
    ELSE CallCatch[Tree.Null];
    Stack.Incr[1];
    P5U.Out0[FOpCodes.qSFC];
    IF localcatch THEN 
      BEGIN
      aroundlabel _ P5U.LabelAlloc[];
      P5U.Out1[FOpCodes.qCATCH, CPtr.cfs];
      P5U.OutJump[JumpA, aroundlabel];
      P5U.OutJump[Jump, firstcatch];
      P5U.InsertLabel[aroundlabel];
      CPtr.cfs _ savcfs;
      END
    ELSE CallCatch[Tree.Null];
    WITH seb[ptsei] SELECT FROM
      transfer => nrets _ P5U.WordsForSei[outRecord];
      ENDCASE;
    END;

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

  Join: PUBLIC PROCEDURE [node: Tree.Index] =
    BEGIN
    [] _ SJoin[node];
    END;

  Unlock: PUBLIC PROCEDURE [node: Tree.Index] =
    BEGIN
    mlock: Tree.Link _ tb[node].son[1];
    IF mlock # Tree.Null THEN
      BEGIN 
      long: BOOLEAN _ P5L.LoadAddress[P5L.VarForLex[P5.Exp[mlock]]]; 
      P5U.Out0[IF long THEN FOpCodes.qMXDL ELSE FOpCodes.qMXD]; 
      END;
    RETURN
    END;

  PRetLex: PUBLIC PROCEDURE [
    nrets: CARDINAL, node: Tree.Index, sig: BOOLEAN _ 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;

  END...