-- Flow.mesa last modified by Sweet, January 16, 1980  9:05 AM

DIRECTORY
  AltoDefs: FROM "altodefs" USING [BYTE, charlength, wordlength],
  Code: FROM "code" USING [
    caseCVState, catchcount, CodeNotImplemented, curctxlvl, dStar],
  CodeDefs: FROM "codedefs" USING [
    EXLabelRecord, EXLRIndex, EXLRNull, JumpType, LabelCCIndex, Lexeme, 
    NullLex, VarComponent, VarIndex],
  ControlDefs: FROM "controldefs" USING [localbase, returnOffset],
  FOpCodes: FROM "fopcodes" USING [
    qDCOMP, qDUCOMP, qFCOMP, qLI, qLL, qLP, qOR, qPUSH, qSFC],
  P5: FROM "p5" USING [
    Exp, FreeHeapLex, GenAnonLex, LogHeapFree, PushLex, PushRhs, 
    StatementTree, SysCall],
  P5L: FROM "p5l" USING [
    EasilyLoadable, FieldOfVar, InCode, LoadAddress, LoadBoth, LoadComponent, 
    LongVarAddress, MakeComponent, ReusableCopies, VarAlignment, VarForLex, Words],
  P5S: FROM "p5s",
  P5U: FROM "p5u" USING [
    FreeChunk, GetChunk, InsertLabel, LabelAlloc, Out0, Out1, OutJump, 
    PushLitVal, TreeLiteral, TreeLiteralValue],
  SDDefs: FROM "sddefs" USING [sBLTE, sBLTEC, sBLTECL, sBLTEL],
  Stack: FROM "stack" USING [Decr, Dump, Incr, Mark, Require],
  Symbols: FROM "symbols" USING [
    ContextLevel, CTXIndex, HTIndex, HTNull, ISEIndex, SEIndex, seType],
  Table: FROM "table" USING [Base, Limit, Notifier],
  Tree: FROM "tree" USING [Index, Link, NodeName, Null, treeType],
  TreeOps: FROM "treeops" USING [ScanList];

Flow: PROGRAM
    IMPORTS CPtr: Code, P5U, CodeDefs, P5L, P5, TreeOps, Stack 
    EXPORTS CodeDefs, P5, P5S =
  BEGIN
  OPEN CodeDefs;

  -- imported definitions

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

  ContextLevel: TYPE = Symbols.ContextLevel;
  CTXIndex: TYPE = Symbols.CTXIndex;
  HTIndex: TYPE = Symbols.HTIndex;
  HTNull: HTIndex = Symbols.HTNull;
  ISEIndex: TYPE = Symbols.ISEIndex;
  SEIndex: TYPE = Symbols.SEIndex;


  CRLabelRecord: TYPE = RECORD [
	free: BOOLEAN,
	retrylabel, contlabel: LabelCCIndex,
	crcc: CARDINAL];

  CRLRIndex: TYPE = Table.Base RELATIVE POINTER [0..Table.Limit) TO CRLabelRecord;
  CRLRNull: CRLRIndex = LOOPHOLE[Table.Limit-1];

  labelStack: EXLRIndex _ EXLRNull;

  CRlabel: CRLRIndex _ CRLRNull;

  UndeclaredLabel: SIGNAL[HTIndex] = CODE;

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

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

  JumpNN: PACKED ARRAY Tree.NodeName[relE..relLE] OF JumpType _ [
	JumpE, JumpN, JumpL, JumpGE, JumpG, JumpLE];

  UJumpNN: PACKED ARRAY Tree.NodeName[relE..relLE] OF JumpType _ [
	JumpE, JumpN, UJumpL, UJumpGE, UJumpG, UJumpLE];

  RNN: ARRAY Tree.NodeName[relE..relLE] OF Tree.NodeName = [
	relE, relN, relG, relLE, relL, relGE];

  CNN: ARRAY Tree.NodeName[relE..relLE] OF Tree.NodeName = [
	relN, relE, relGE, relL, relLE, relG];

  FlowTree: PUBLIC PROCEDURE [t: Tree.Link, tf: BOOLEAN, label: LabelCCIndex] =
    BEGIN -- produces code to jump to label on condition tf
    node: Tree.Index;
    label1: LabelCCIndex;
    sw: BOOLEAN;

    WITH t SELECT FROM
      symbol =>
	BEGIN
	l: se Lexeme;
        IF ~CPtr.dStar THEN Stack.Dump[];
	l _ [se[index]];
	P5.PushLex[l];
	P5U.PushLitVal[0];
	P5U.OutJump[IF tf THEN JumpN ELSE JumpE, label];
	RETURN
	END;
      subtree =>
	BEGIN
	node _ index;
	SELECT tb[node].name FROM
	  and, or =>
	    BEGIN ENABLE P5.LogHeapFree => RESUME[FALSE, NullLex];
	    sw _ IF tb[node].name = and THEN tf ELSE ~tf;
	    IF sw THEN
	      BEGIN
	      label1_P5U.LabelAlloc[];
	      FlowTree[tb[node].son[1], ~tf, label1];
	      FlowTree[tb[node].son[2], tf, label];
	      P5U.InsertLabel[label1];
	      END
	    ELSE
	      BEGIN
	      FlowTree[tb[node].son[1], tf, label];
	      FlowTree[tb[node].son[2], tf, label];
	      END;
	    END;
	  not => FlowTree[tb[node].son[1], ~tf, label];
	  in => FlowIn[t, tf, label];
	  notin => FlowIn[t, ~tf, label];
	  relE, relN, relL, relGE, relG, relLE =>
	    SFRel[node, tf, label];
	  ENDCASE => -- must be a BOOLEAN expression
	    BEGIN
	    IF ~CPtr.dStar THEN 
	      IF t = Tree.Null AND CPtr.caseCVState = singleLoaded THEN
		Stack.Require[1]
	      ELSE Stack.Dump[];
	    P5.PushRhs[t];
	    P5U.PushLitVal[0];
	    P5U.OutJump[IF tf THEN JumpN ELSE JumpE, label];
	    END;
	END;
      literal =>
	BEGIN
	val: CARDINAL _ P5U.TreeLiteralValue[t];
	IF tf = (val # 0) THEN P5U.OutJump[Jump, label];
	END;
      ENDCASE;
    RETURN
    END;

  SFRel: PROCEDURE [node: Tree.Index, tf: BOOLEAN, label: LabelCCIndex] =
    BEGIN -- main subroutine of Cflow for handling relationals
    t1: Tree.Link _ tb[node].son[1];
    t2: Tree.Link;
    n: Tree.NodeName _ tb[node].name;
    hLex1, hLex2: se Lexeme _ NullLex;
    r1, r2: VarIndex;

    IF ~CPtr.dStar THEN 
      IF t1 = Tree.Null AND CPtr.caseCVState = singleLoaded THEN
	Stack.Require[1]
      ELSE Stack.Dump[];
    IF P5U.TreeLiteral[t1] THEN
      BEGIN
      n _ RNN[n];
      t2 _ t1; t1 _ tb[node].son[2];
      END
    ELSE t2 _ tb[node].son[2];
    IF ~tf THEN n _ CNN[n];
    r1 _ P5L.VarForLex[P5.Exp[t1!P5.LogHeapFree =>
      IF calltree = t1 THEN RESUME[TRUE, hLex1 _ P5.GenAnonLex[1]]]];
    r2 _ P5L.VarForLex[P5.Exp[t2!P5.LogHeapFree =>
      IF calltree = t2 THEN RESUME[TRUE, hLex2 _ P5.GenAnonLex[1]]]];
    VarVarComp[
      r1: r1, r2: r2, n: n,
      real: tb[node].attr1, signed: tb[node].attr3, 
      hLex1: hLex1, hLex2: hLex2, label: label];
    END;

  VarVarComp: PUBLIC PROCEDURE [r1, r2: VarIndex, n: Tree.NodeName, real, signed: BOOLEAN, hLex1, hLex2: se Lexeme, label: LabelCCIndex] =
    BEGIN -- if ~dStar, stack should be "empty" when called
    wSize: CARDINAL;
    bSize, bd1, bd2: [0..wordlength);
    ws: CARDINAL;

    FreeHeapNodes: PROCEDURE =
      BEGIN
      IF hLex1 # NullLex THEN P5.FreeHeapLex[hLex1];
      IF hLex2 # NullLex THEN P5.FreeHeapLex[hLex2];
      hLex1 _ hLex2 _ NullLex;
      END;

    [wSize: wSize, bSize: bSize, bd: bd1] _ P5L.VarAlignment[r1, load];
    [bd: bd2] _ P5L.VarAlignment[r2, load];
    ws _ P5L.Words[wSize, bSize]; -- r1 and r2 are same size if > 1
    IF ws > 1 AND bd1 # bd2 THEN SIGNAL CPtr.CodeNotImplemented;
    IF ws <= 2 THEN
      BEGIN
      c1: VarComponent _ P5L.MakeComponent[r1];
      c2: VarComponent _ P5L.MakeComponent[r2];
      BEGIN
      IF n = relE OR n = relN THEN WITH c2 SELECT FROM
	const => IF wSize = 2 AND bSize = 0 AND d1 = 0 AND d2 = 0 THEN
	  BEGIN
	  P5L.LoadComponent[c1];
	  P5U.Out0[FOpCodes.qOR];
	  GO TO double;
	  END;
	ENDCASE;
      P5L.LoadBoth[@c1, @c2, FALSE];
      IF ws = 2 THEN
	BEGIN
	P5U.Out0[IF real THEN FOpCodes.qFCOMP 
	  ELSE IF signed THEN FOpCodes.qDCOMP ELSE FOpCodes.qDUCOMP];
	GO TO double;
	END;
      FreeHeapNodes[];
      EXITS
	double => BEGIN FreeHeapNodes[]; P5U.Out1[FOpCodes.qLI, 0] END;
      END;
      P5U.OutJump[IF signed OR ws = 2 THEN JumpNN[n] ELSE UJumpNN[n], label];
      END
    ELSE
      BEGIN -- multiword quantities, n = relE or relN
      IF bSize = 0 THEN
	BEGIN
	code: BOOLEAN _ FALSE;
	long1, long2: BOOLEAN;
	CompFn: ARRAY BOOLEAN OF ARRAY BOOLEAN OF BYTE = [
	  [SDDefs.sBLTE, SDDefs.sBLTEL], [SDDefs.sBLTEC, SDDefs.sBLTECL]];

	Stack.Dump[]; Stack.Mark[]; -- so procedure call will work
	IF P5L.InCode[r1] THEN
	  BEGIN tr: VarIndex = r1; r1 _ r2; r2 _ tr END;
	IF P5L.InCode[r2] THEN code _ TRUE;
	long2 _ P5L.LongVarAddress[r2];
	long1 _ P5L.LoadAddress[r: r1, codeOk: FALSE];
	IF ~long1 AND long2 THEN 
	  BEGIN P5U.Out0[FOpCodes.qLP]; long1 _ TRUE END;
	P5U.Out1[FOpCodes.qLI, ws];
	[] _ P5L.LoadAddress[r: r2, codeOk: TRUE];
	IF ~code AND long1 AND ~long2 THEN P5U.Out0[FOpCodes.qLP];
	P5.SysCall[CompFn[code][long1]];
	Stack.Incr[1];
        FreeHeapNodes[];
	P5U.Out1[FOpCodes.qLI, 0];
	P5U.OutJump[IF n # relE THEN JumpE ELSE JumpN, label]
	END
      ELSE
	BEGIN -- do in two pieces
	r1a, r1b: VarIndex;
	r2a, r2b: VarIndex;
	firstEq, secondComp: LabelCCIndex;

	[r1a, r1b] _ P5L.ReusableCopies[r1, load];
	[r2a, r2b] _ P5L.ReusableCopies[r2, load];
	IF bd1 # 0 THEN
	  BEGIN
	  P5L.FieldOfVar[r: r1b, bSize: bSize];
	  P5L.FieldOfVar[r: r1a, bd: bSize, wSize: wSize];
	  P5L.FieldOfVar[r: r2b, bSize: bSize];
	  P5L.FieldOfVar[r: r2a, bd: bSize, wSize: wSize];
	  END
	ELSE
	  BEGIN
	  P5L.FieldOfVar[r: r1b, wSize: wSize];
	  P5L.FieldOfVar[r: r1a, wd: wSize, bSize: bSize];
	  P5L.FieldOfVar[r: r2b, wSize: wSize];
	  P5L.FieldOfVar[r: r2a, wd: wSize, bSize: bSize];
	  END;
        secondComp _ P5U.LabelAlloc[];
	IF n = relN THEN firstEq _ label 
	ELSE firstEq _ P5U.LabelAlloc[];
	VarVarComp[
	  r1b, r2b, relE, real, signed, NullLex, NullLex, secondComp];
	FreeHeapNodes[];  -- this looks awful here, but Final sorts it all out
	P5U.OutJump[Jump, firstEq];
	P5U.InsertLabel[secondComp];
	VarVarComp[r1a, r2a, n, real, signed, hLex1, hLex2, label];
	IF n # relN THEN P5U.InsertLabel[firstEq];
	END;
      END;
    END;

  FlowIn: PUBLIC PROCEDURE [t: Tree.Link, tf: BOOLEAN, label: LabelCCIndex] =
    BEGIN -- generates code for IN expression in flow context
    node: Tree.Index;
    n: Tree.NodeName;
    fail: LabelCCIndex _ P5U.LabelAlloc[];
    jumpNN: POINTER TO PACKED ARRAY Tree.NodeName[relE..relLE] OF JumpType;
    double, real: BOOLEAN;
    signed: BOOLEAN;
    r1: VarIndex;
    var1: VarComponent;
    t1: Tree.Link;
    hLex: se Lexeme _ NullLex;

    WITH t SELECT FROM
      subtree =>
	BEGIN
	node _ index;
	t1 _ tb[node].son[1];
	WITH tb[node].son[2] SELECT FROM -- the interval node
	  subtree =>
	    BEGIN
	    inn: Tree.Index _ index;
	    real _ tb[inn].attr1;
	    double _ real OR tb[inn].attr2;
	    signed _ tb[inn].attr3;
	    END;
	  ENDCASE => ERROR;
        IF real OR ~CPtr.dStar THEN  
          IF t = Tree.Null AND CPtr.caseCVState = singleLoaded THEN
	    Stack.Require[1]
          ELSE Stack.Dump[];
	r1 _ P5L.VarForLex[P5.Exp[t1 ! P5.LogHeapFree =>
          IF calltree = t1 THEN RESUME[TRUE, hLex _ P5.GenAnonLex[1]]]];
	var1 _ P5L.MakeComponent[r1];
	IF double THEN var1 _ P5L.EasilyLoadable[var1, load];
	P5L.LoadComponent[var1];
	IF hLex # NullLex THEN
	  BEGIN P5.FreeHeapLex[hLex]; hLex _ NullLex END;

	WITH tb[node].son[2] SELECT FROM
	  subtree =>
	    BEGIN
	    node _ index;
	    jumpNN _ IF double OR signed THEN @JumpNN ELSE @UJumpNN;
	    n _ tb[node].name;
	    P5.PushRhs[tb[node].son[1] ! P5.LogHeapFree =>
	      IF calltree = t1 THEN RESUME[TRUE, hLex _ P5.GenAnonLex[1]]];
	    IF double THEN
	      BEGIN
	      P5U.Out0[IF real THEN FOpCodes.qFCOMP
		ELSE IF signed THEN FOpCodes.qDCOMP
		  ELSE FOpCodes.qDUCOMP];
	      P5U.PushLitVal[0];
	      END;
	    IF hLex # NullLex THEN
	      BEGIN P5.FreeHeapLex[hLex]; hLex _ NullLex END;
	    SELECT n FROM
	      intOO,intOC => P5U.OutJump[jumpNN[relLE],
		IF tf THEN fail ELSE label];
	      intCO,intCC => P5U.OutJump[jumpNN[relL],
		IF tf THEN fail ELSE label];
	      ENDCASE;
	    IF double THEN P5L.LoadComponent[var1]
	    ELSE P5U.Out0[FOpCodes.qPUSH];
	    P5.PushRhs[tb[node].son[2] ! P5.LogHeapFree =>
	      IF calltree = t1 THEN RESUME[TRUE, hLex _ P5.GenAnonLex[1]]];
	    IF double THEN
	      BEGIN
	      P5U.Out0[IF real THEN FOpCodes.qFCOMP
		ELSE IF signed THEN FOpCodes.qDCOMP
		  ELSE FOpCodes.qDUCOMP];
	      P5U.PushLitVal[0];
	      END;
	    IF hLex # NullLex THEN P5.FreeHeapLex[hLex]; 
	    SELECT n FROM
	      intOO,intCO => P5U.OutJump[
	        IF tf THEN jumpNN[relL] ELSE jumpNN[relGE],label];
	      intOC,intCC => P5U.OutJump[
	        IF tf THEN jumpNN[relLE] ELSE jumpNN[relG],label];
	      ENDCASE;
	    P5U.InsertLabel[fail];
	    RETURN
	    END;
	  ENDCASE
	END;
      ENDCASE
    END;


  CatchMark: PUBLIC PROCEDURE [node: Tree.Index] =
    BEGIN -- process a CONTINUEd or RETRYed statement
    savCRlabel: CRLRIndex _ CRlabel;
    l: CRLRIndex _ P5U.GetChunk[SIZE[CRLabelRecord]];
    elabel: LabelCCIndex;

    CRlabel _ l;
    cb[l].free _ FALSE;
    P5U.InsertLabel[cb[l].retrylabel _ P5U.LabelAlloc[]];
    elabel _ cb[l].contlabel _ P5U.LabelAlloc[];
    cb[l].crcc _ CPtr.catchcount;
    tb[node].son[1] _ P5.StatementTree[tb[node].son[1]];
    P5U.InsertLabel[elabel];
    CRlabel _ savCRlabel;
    P5U.FreeChunk[l, SIZE[CRLabelRecord]];
    RETURN
    END;


  Label: PUBLIC PROCEDURE [node: Tree.Index] =
    BEGIN -- process an exitable block
    elabel: LabelCCIndex _ P5U.LabelAlloc[];
    labelmark: EXLRIndex _ labelStack;

    TreeOps.ScanList[tb[node].son[2], LabelCreate];
    tb[node].son[1] _ P5.StatementTree[tb[node].son[1]];
    P5U.OutJump[Jump, elabel];
    LabelList[tb[node].son[2], elabel];
    P5U.InsertLabel[elabel];
    PopLabels[labelmark];
    RETURN
    END;


  GetLabelMark: PUBLIC PROCEDURE RETURNS [EXLRIndex] =
    BEGIN RETURN[labelStack] END;


  PopLabels: PUBLIC PROCEDURE [labelmark: EXLRIndex] =
    BEGIN
    oldl: EXLRIndex;

    UNTIL labelStack = labelmark DO
      oldl _ labelStack;
      labelStack _ cb[labelStack].thread;
      P5U.FreeChunk[oldl, SIZE[EXLabelRecord]];
      ENDLOOP;
    RETURN
    END;



  LabelList: PUBLIC PROCEDURE [t: Tree.Link, elabel: LabelCCIndex] =
    BEGIN -- generates code for labels
    Clabelitem: PROCEDURE [t: Tree.Link] =
      BEGIN -- generates code for a labelitem
      WITH t SELECT FROM
	subtree =>
	  BEGIN
	  TreeOps.ScanList[tb[index].son[1], PutLabel];
	  tb[index].son[2] _ P5.StatementTree[tb[index].son[2]];
	  P5U.OutJump[Jump, elabel];
	  RETURN
	  END;
	ENDCASE
    END;

    TreeOps.ScanList[t, Clabelitem];
    RETURN
    END;


  PutLabel: PROCEDURE [t: Tree.Link] =
    BEGIN
    WITH t SELECT FROM
      hash => P5U.InsertLabel[cb[FindLabel[index]].labelcci];
      ENDCASE;
    RETURN
    END;


  LabelCreate: PUBLIC PROCEDURE [t: Tree.Link] =
    BEGIN -- sets up label cells for labels
    WITH t SELECT FROM
      subtree => TreeOps.ScanList[tb[index].son[1], PushLabel];
      ENDCASE;
    RETURN
    END;


  PushLabel: PROCEDURE [t: Tree.Link] =
    BEGIN -- stacks a label for an EXIT clause
    l: EXLRIndex _ P5U.GetChunk[SIZE[EXLabelRecord]];

    WITH t SELECT FROM
      hash =>
	BEGIN
	cb[l] _
	  EXLabelRecord[free: FALSE, thread: labelStack, labelhti: index,
		labelcc: CPtr.catchcount, labelcci: P5U.LabelAlloc[]];
	labelStack _ l;
	RETURN;
	END;
      ENDCASE
    END;


  MakeExitLabel: PUBLIC PROCEDURE RETURNS [exit, loop: LabelCCIndex] =
    BEGIN -- sets up anonymous label for EXITs
    l: EXLRIndex _ P5U.GetChunk[SIZE[EXLabelRecord]];

    exit _ P5U.LabelAlloc[];
    loop _ P5U.LabelAlloc[];
    cb[l] _
	EXLabelRecord[free: FALSE, thread: labelStack, labelhti: HTNull,
		labelcc: CPtr.catchcount, labelcci: loop];
    labelStack _ l;
    l _ P5U.GetChunk[SIZE[EXLabelRecord]];
    cb[l] _
	EXLabelRecord[free: FALSE, thread: labelStack, labelhti: HTNull,
		labelcc: CPtr.catchcount, labelcci: exit];
    labelStack _ l;
    RETURN
    END;


  FindLabel: PROCEDURE [hti: HTIndex] RETURNS [c: EXLRIndex] =
    BEGIN -- searches down label stack for label hti
    FOR c _ labelStack, cb[c].thread UNTIL c = EXLRNull DO
      IF cb[c].labelhti = hti THEN RETURN
      ENDLOOP;
    SIGNAL UndeclaredLabel[hti];
    RETURN
    END;


  Retry: PUBLIC PROCEDURE =
    BEGIN -- process RETRY statement
    RetContExit[cb[CRlabel].crcc, cb[CRlabel].retrylabel];
    RETURN
    END;


  Continue: PUBLIC PROCEDURE =
    BEGIN -- process CONTINUE statement
    RetContExit[cb[CRlabel].crcc, cb[CRlabel].contlabel];
    RETURN
    END;


  Exit: PUBLIC PROCEDURE =
    BEGIN  -- generate code for EXIT
    l: EXLRIndex _ FindLabel[HTNull];

    RetContExit[cb[l].labelcc, cb[l].labelcci];
    RETURN
    END;

  Loop: PUBLIC PROCEDURE =
    BEGIN  -- generate code for EXIT
    l: EXLRIndex _ FindLabel[HTNull];

    l _ cb[l].thread;
    RetContExit[cb[l].labelcc, cb[l].labelcci];
    RETURN
    END;


  GoTo: PUBLIC PROCEDURE [node: Tree.Index] =
    BEGIN  -- generate code for GOTO
    l: EXLRIndex;

    WITH tb[node].son[1] SELECT FROM
      hash => l _ FindLabel[index];
      ENDCASE;
    RetContExit[cb[l].labelcc, cb[l].labelcci];
    RETURN
    END;


  RetContExit: PROCEDURE [cc: CARDINAL, lc: LabelCCIndex] =
    BEGIN -- process EXIT/REPEAT statement
    IF CPtr.catchcount = cc THEN P5U.OutJump[Jump, lc]
    ELSE
      BEGIN
      var: VarComponent _ [wSize: 1, space: frame[
	wd: ControlDefs.localbase,
	level: CPtr.curctxlvl-(CPtr.catchcount-cc-1)]];
      P5L.LoadComponent[var];
      P5U.PushLitVal[-1];
      P5U.Out1[FOpCodes.qLL, ControlDefs.returnOffset];
      P5U.Out0[FOpCodes.qSFC];
      Stack.Decr[2];
      P5U.OutJump[Jump, lc];
      END;
    RETURN
    END;




END...