-- CgenUtil.mesa, last modified by Sweet, November 28, 1979  10:04 AM

DIRECTORY
  AltoDefs: FROM "altodefs" USING [Address, BYTE, wordlength],
  Code: FROM "code" USING [
    CodePassInconsistency, codeptr, fileindex, stking, xtracting, 
    xtractsei, ZEROlexeme],
  CodeDefs: FROM "codedefs" USING [
    CCIndex, CCItem, CCNull, ChunkIndex, CodeCCIndex, CodeChunkType, 
    JumpCCIndex, JumpCCNull, JumpType, LabelCCIndex, LabelCCNull, Lexeme, 
    NULLfileindex],
  ComData: FROM "comdata" USING [typeSTRING],
  ControlDefs: FROM "controldefs" USING [FrameVec],
  FOpCodes: FROM "fopcodes" USING [qJ, qJREL, qLI],
  LiteralOps: FROM "literalops" USING [Find, Value],
  MiscDefs: FROM "miscdefs" USING [CallDebugger],
  OpTableDefs: FROM "optabledefs" USING [instlength],
  P5: FROM "p5" USING [NumberOfParams, P5Error, PushEffect],
  P5U: FROM "p5u",
  Stack: FROM "stack" USING [Check, Depth],
  SymbolOps: FROM "symbolops" USING [
    NextSe, RecordRoot, UnderType, WordsForType],
  Symbols: FROM "symbols" USING [
    BitAddress, bodyType, BTIndex, BTNull, CBTIndex, ContextLevel, CSEIndex, 
    CSENull, CTXIndex, ctxType, HTIndex, HTNull, ISEIndex, ISENull, lG, lL, 
    MDIndex, RecordSEIndex, RecordSENull, SEIndex, SENull, seType, typeTYPE],
  SymbolSegment: FROM "symbolsegment" USING [ByteIndex],
  SystemDefs: FROM "systemdefs" USING [AllocateHeapNode, FreeHeapNode],
  Table: FROM "table" USING [Base, FreeChunk, GetChunk, Notifier],
  Tree: FROM "tree" USING [Index, Link, Null, NullIndex, treeType],
  TreeOps: FROM "treeops" USING [ScanList];

CgenUtil: PROGRAM
    IMPORTS MPtr: ComData, CPtr: Code, CodeDefs, LiteralOps, MiscDefs, OpTableDefs, P5, Stack, SymbolOps, SystemDefs, Table, TreeOps 
    EXPORTS CodeDefs, P5U =
  BEGIN
  OPEN SymbolOps, CodeDefs;
  -- imported definitions

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


  BitAddress: TYPE = Symbols.BitAddress;
  BTIndex: TYPE = Symbols.BTIndex;
  CBTIndex: TYPE = Symbols.CBTIndex;
  BTNull: BTIndex = Symbols.BTNull;
  ContextLevel: TYPE = Symbols.ContextLevel;
  CSEIndex: TYPE = Symbols.CSEIndex;
  CSENull: CSEIndex = Symbols.CSENull;
  CTXIndex: TYPE = Symbols.CTXIndex;
  HTIndex: TYPE = Symbols.HTIndex;
  HTNull: HTIndex = Symbols.HTNull;
  ISEIndex: TYPE = Symbols.ISEIndex;
  ISENull: ISEIndex = Symbols.ISENull;
  lG: ContextLevel = Symbols.lG;
  lL: ContextLevel = Symbols.lL;
  MDIndex: TYPE = Symbols.MDIndex;
  RecordSEIndex: TYPE = Symbols.RecordSEIndex;
  RecordSENull: RecordSEIndex = Symbols.RecordSENull;
  SEIndex: TYPE = Symbols.SEIndex;
  SENull: SEIndex = Symbols.SENull;
  typeTYPE: CSEIndex = Symbols.typeTYPE;


  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)

  CgenUtilNotify: 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;

  codeindex: SymbolSegment.ByteIndex;

  AllocCodeCCItem: PUBLIC PROCEDURE [n: [0..3]] RETURNS [c: CodeCCIndex] =
    BEGIN
    c _ GetChunk[SIZE[code CCItem] + n];
    cb[c] _
	  CCItem[free: FALSE, pad:0, flink: CCNull, blink: CCNull, ccvalue:
		code[inst: 0, realinst: FALSE, minimalStack: FALSE,
		sourcefileindex: NULLfileindex,
		isize: 0, aligned: FALSE, fill: 0, parameters: ]];
    IF CPtr.stking THEN cb[c].sourcefileindex _ codeindex;
    linkCCItem[c];
    RETURN
    END;

  BitsForOperand: PUBLIC PROCEDURE [t: Tree.Link] RETURNS [CARDINAL] =
    BEGIN
    WITH t SELECT FROM
      literal => RETURN [wordlength]; -- not always TRUE, but good enough
      ENDCASE;
    RETURN[BitsForType[OperandType[t]]]
    END;

  BitsForType: PUBLIC PROCEDURE [sei: SEIndex] RETURNS [CARDINAL] =
    BEGIN
    csei: CSEIndex _ UnderType[sei];

    WITH seb[csei] SELECT FROM
      record => RETURN[length];
      ENDCASE => RETURN[SymbolOps.WordsForType[csei]*wordlength]
    END;

  CCellAlloc: PUBLIC PROCEDURE [t: CodeChunkType] =
    BEGIN -- allocates a cell for other than code or label
    c: CCIndex;
    nwords: CARDINAL;

    codeindex _ MAX[CPtr.fileindex, codeindex];
    SELECT t FROM
      code => P5.P5Error[262];
      label => P5.P5Error[263];
      jump => nwords _ SIZE[jump CCItem];
      other => nwords _ SIZE[other CCItem];
      ENDCASE;
    c _ GetChunk[nwords];
    SELECT t FROM
      jump =>
	cb[c] _
	  CCItem[free: FALSE, pad:0, flink: , blink: , ccvalue: jump[,,,,,,,]];
      other =>
	cb[c] _
	  CCItem[free: FALSE, pad:0, flink: , blink: , ccvalue: other[obody: ]];
      ENDCASE;
    linkCCItem[c];
    RETURN
    END;

  CgenUtilInit: PUBLIC PROCEDURE =
    BEGIN
    CPtr.ZEROlexeme _ Lexeme[literal[word[LiteralOps.Find[0]]]];
    codeindex _ CPtr.fileindex _ 0;
    END;

  ComputeFrameSize: PUBLIC PROCEDURE [fs: CARDINAL] RETURNS [CARDINAL] =
    BEGIN -- finds alloc-vector index for frame of size fs
    OPEN ControlDefs;
    fx: CARDINAL;
    FOR fx IN [0..LENGTH[FrameVec]) DO
      IF fs <= FrameVec[fx] THEN RETURN [fx] ENDLOOP;
    ERROR;
    END;

  CreateLabel: PUBLIC PROCEDURE RETURNS [c: LabelCCIndex] =
    BEGIN -- allocates and inserts a label at codeptr
    c _ LabelAlloc[];
    InsertLabel[c];
    RETURN
    END;

  DeleteCell: PUBLIC PROCEDURE [c: CCIndex] =
    BEGIN -- deletes cell from code stream
    nwords: CARDINAL;

    IF cb[c].blink # CCNull THEN
      cb[cb[c].blink].flink _ cb[c].flink;
    IF cb[c].flink # CCNull THEN
      cb[cb[c].flink].blink _ cb[c].blink;
    WITH cb[c] SELECT FROM
      code => nwords _ ParamCount[LOOPHOLE[c]] + SIZE[code CCItem];
      label => nwords _ SIZE[label CCItem];
      jump => nwords _ SIZE[jump CCItem];
      other => nwords _ SIZE[other CCItem];
      ENDCASE;
    FreeChunk[c, nwords];
    RETURN
    END;

  EnumerateCaseArms: PUBLIC PROCEDURE [node: Tree.Index, 
    action: PROCEDURE [t: Tree.Link]] =
    BEGIN
    ProcessItem: PROCEDURE [t: Tree.Link] =
      BEGIN
      inode: Tree.Index;
      WITH t SELECT FROM
	subtree => inode _ index;
	ENDCASE;
      SELECT tb[inode].name FROM
	item => action[tb[inode].son[2]];
	caseswitch => TreeOps.ScanList[tb[inode].son[3], ProcessItem];
        ENDCASE;
      END;
    TreeOps.ScanList[tb[node].son[2], ProcessItem];
    IF tb[node].son[3] # Tree.Null THEN action[tb[node].son[3]];
    END;

  FieldAddress: PUBLIC PROCEDURE [sei: ISEIndex] RETURNS [BitAddress, CARDINAL] =
    BEGIN
    RETURN [seb[sei].idValue, seb[sei].idInfo]
    END;

  FreeChunk: PUBLIC PROCEDURE [i: CodeDefs.ChunkIndex, size: CARDINAL] =
    BEGIN
    p: POINTER TO MonitorRecord;

    FOR p _ monList, p.next WHILE p # NIL DO
      IF p.cell = i AND p.action = free THEN MiscDefs.CallDebugger["From FreeChunk"L];
      ENDLOOP;
    Table.FreeChunk[LOOPHOLE[i],size];
    END;

  FullWordBits: PUBLIC PROCEDURE [bits: CARDINAL] RETURNS [CARDINAL] =
    BEGIN
    RETURN[((bits+wordlength-1)/wordlength) * wordlength]
    END;

  GetChunk: PUBLIC PROCEDURE [size: CARDINAL] RETURNS [c: CodeDefs.ChunkIndex] =
    BEGIN
    p: POINTER TO MonitorRecord;

    c _ LOOPHOLE[Table.GetChunk[size]];
    FOR p _ monList, p.next WHILE p # NIL DO
      IF p.cell = c AND p.action = allocate THEN MiscDefs.CallDebugger["From GetChunk"L];
      ENDLOOP;
    RETURN [c];
    END;

  InsertLabel: PUBLIC PROCEDURE [c: LabelCCIndex] =
    BEGIN -- puts a label chunk in the code stream
    IF CPtr.codeptr # CCNull THEN
      BEGIN
      cb[c].flink _ cb[CPtr.codeptr].flink;
      IF cb[CPtr.codeptr].flink # CCNull THEN
	cb[cb[CPtr.codeptr].flink].blink _ c;
      cb[CPtr.codeptr].flink _ c;
      END
    ELSE cb[c].flink _ CCNull;
    cb[c].blink _ CPtr.codeptr;
    CPtr.codeptr _ c;
    RETURN
    END;

  LabelAlloc: PUBLIC PROCEDURE RETURNS [c: LabelCCIndex] =
    BEGIN -- gets a chunk for a label but does not insert it in stream
    c _ GetChunk[SIZE[label CCItem]];
    cb[c] _
	CCItem[free: FALSE, pad:0, flink: , blink: , ccvalue: label[labelseen: FALSE, labelinfo: generating[filltoword: , jumplist: JumpCCNull]]];
    RETURN
    END;

  linkCCItem: PROCEDURE[c: CCIndex] =
    BEGIN -- inserts a CCItem in list @ codeptr
    IF CPtr.codeptr # CCNull THEN
      BEGIN
      cb[c].flink _ cb[CPtr.codeptr].flink;
      IF cb[CPtr.codeptr].flink # CCNull THEN
	cb[cb[CPtr.codeptr].flink].blink _ c;
      cb[CPtr.codeptr].flink _ c;
      END
    ELSE cb[c].flink _ CCNull;
    cb[c].blink _ CPtr.codeptr;
    CPtr.codeptr _ c;
    RETURN
    END;

  LongTreeAddress: PUBLIC PROCEDURE [t: Tree.Link] RETURNS [long: BOOLEAN] =
    BEGIN
    node: Tree.Index;
    WITH t SELECT FROM
      subtree =>
        BEGIN  node _ index;
        IF node = Tree.NullIndex
          THEN  long _ FALSE
          ELSE  SELECT tb[node].name FROM
            loophole, cast, openx, pad, chop =>
              long _ LongTreeAddress[tb[node].son[1]];
            dot, uparrow, dindex, seqindex, dollar, index, reloc =>
              long _ tb[node].attr2;
	    assignx => WITH tb[node].son[2] SELECT FROM
	      subtree => IF tb[index].name = mwconst THEN 
		  long _ LongTreeAddress[tb[node].son[1]]
		ELSE long _ LongTreeAddress[tb[node].son[2]];
	      ENDCASE => long _ LongTreeAddress[tb[node].son[2]];
	    ifx => long _ LongTreeAddress[tb[node].son[2]] OR
		LongTreeAddress[tb[node].son[3]];
	    casex =>
	      BEGIN
	      LongArm: PROCEDURE [t: Tree.Link] =
		BEGIN
		long _ long OR LongTreeAddress[t];
		END;
	      long _ FALSE;
	      EnumerateCaseArms[node, LongArm];
	      END;
            ENDCASE => long _ FALSE;
        END;
      ENDCASE => long _ FALSE;
    RETURN
    END;

  MakeTreeLiteral: PUBLIC PROCEDURE [val: WORD] RETURNS [Tree.Link] =
    BEGIN
    RETURN [Tree.Link[literal[[word[index: LiteralOps.Find[val]]]]]]
    END;

  MonitorAction: TYPE = {allocate, free};
  MonitorRecord: TYPE = RECORD [next: POINTER TO MonitorRecord, cell: CCIndex, action: MonitorAction];
  monList: POINTER TO MonitorRecord _ NIL;
  Monitor: PROCEDURE [cell: CCIndex, action: MonitorAction] =
    BEGIN
    p: POINTER TO MonitorRecord;
    p _ SystemDefs.AllocateHeapNode[SIZE[MonitorRecord]];
    p^ _ [monList, cell, action];
    monList _ p;
    END;

  NextVar: PUBLIC PROCEDURE [sei: ISEIndex] RETURNS [ISEIndex] =
    BEGIN -- starting at sei returns first variable on ctx-list
    IF sei = ISENull THEN RETURN [ISENull];
    DO
      IF seb[sei].idType # typeTYPE THEN RETURN [sei];
      IF (sei _ SymbolOps.NextSe[sei]) = ISENull THEN EXIT;
      ENDLOOP;
    RETURN [ISENull];
    END;

  OperandType: PUBLIC PROCEDURE [t: Tree.Link] RETURNS [sei: CSEIndex] =
    BEGIN -- compute number of words for storing value of tree
    WITH e:t SELECT FROM
      literal =>
	WITH e.info SELECT FROM
	  string => sei _ MPtr.typeSTRING;
	  ENDCASE => SIGNAL CPtr.CodePassInconsistency;
      symbol => sei _ UnderType[seb[e.index].idType];
      subtree =>
	IF e = Tree.Null THEN
	  IF CPtr.xtracting THEN
	    sei _ UnderType[seb[CPtr.xtractsei].idType]
	  ELSE ERROR
	ELSE sei _ tb[e.index].info;
      ENDCASE;
    RETURN
    END;

  Out0: PUBLIC PROCEDURE [i: BYTE] =
    BEGIN -- outputs an parameter-less instruction
    c: CodeCCIndex;
    pusheffect: CARDINAL = P5.PushEffect[i];

    Stack.Check[i];
    IF P5.NumberOfParams[i] # 0 THEN P5.P5Error[257];
    codeindex _ MAX[CPtr.fileindex, codeindex];
    c _ AllocCodeCCItem[0];
    cb[c].inst _ i;
    cb[c].minimalStack _ Stack.Depth[] = pusheffect;
    RETURN
    END;

  Out1: PUBLIC PROCEDURE [i: BYTE, p1: WORD] =
    BEGIN -- outputs an one-parameter instruction
    c: CodeCCIndex;
    pusheffect: CARDINAL = P5.PushEffect[i];

    Stack.Check[i];
    IF P5.NumberOfParams[i] # 1 THEN P5.P5Error[258];
    codeindex _ MAX[CPtr.fileindex, codeindex];
    c _ AllocCodeCCItem[1];
    cb[c].inst _ i;
    cb[c].parameters[1] _ p1;
    cb[c].minimalStack _ Stack.Depth[] = pusheffect;
    RETURN
    END;

  Out2: PUBLIC PROCEDURE [i: BYTE, p1, p2: WORD] =
    BEGIN -- outputs an two-parameter instruction
    c: CodeCCIndex;
    pusheffect: CARDINAL = P5.PushEffect[i];

    Stack.Check[i];
    IF P5.NumberOfParams[i] # 2 THEN P5.P5Error[259];
    codeindex _ MAX[CPtr.fileindex, codeindex];
    c _ AllocCodeCCItem[2];
    cb[c].inst _ i;
    cb[c].parameters[1] _ p1;
    cb[c].parameters[2] _ p2;
    cb[c].minimalStack _ Stack.Depth[] = pusheffect;
    RETURN
    END;

  Out3: PUBLIC PROCEDURE [i: BYTE, p1, p2, p3: WORD] =
    BEGIN -- outputs an three-parameter instruction
    c: CodeCCIndex;
    pusheffect: CARDINAL = P5.PushEffect[i];

    Stack.Check[i];
    IF P5.NumberOfParams[i] # 3 THEN P5.P5Error[260];
    codeindex _ MAX[CPtr.fileindex, codeindex];
    c _ AllocCodeCCItem[3];
    cb[c].inst _ i;
    cb[c].parameters[1] _ p1;
    cb[c].parameters[2] _ p2;
    cb[c].parameters[3] _ p3;
    cb[c].minimalStack _ Stack.Depth[] = pusheffect;
    RETURN
    END;

  OutJump: PUBLIC PROCEDURE [jt: JumpType, l: LabelCCIndex] =
    BEGIN -- outputs a jump-type code ceel into the code stream
    SELECT jt FROM
	  Jump, JumpA, JumpC, JumpCA, JumpRet => Stack.Check[FOpCodes.qJ];
	  ENDCASE => Stack.Check[FOpCodes.qJREL];
    CCellAlloc[jump];
    WITH cb[CPtr.codeptr] SELECT FROM
      jump =>
	BEGIN
	fixedup _ FALSE;
	completed _ FALSE;
	jtype _ jt;
	destlabel _ l;
	IF l # LabelCCNull THEN
	  BEGIN
	  thread _ cb[l].jumplist;
	  cb[l].jumplist _ LOOPHOLE[CPtr.codeptr, JumpCCIndex];
	  END
	ELSE thread _ JumpCCNull;
	RETURN
	END;
      ENDCASE
    END;

  ParamCount: PUBLIC PROCEDURE [c: CodeCCIndex] RETURNS [CARDINAL] =
    BEGIN
    RETURN[IF cb[c].isize # 0 THEN cb[c].isize-1 
	ELSE IF cb[c].realinst THEN OpTableDefs.instlength[cb[c].inst]-1
	   ELSE P5.NumberOfParams[cb[c].inst]]
    END;

  PrevVar: PUBLIC PROCEDURE [ssei, sei : ISEIndex] RETURNS [ISEIndex] =
    BEGIN -- returns vars in reverse order as those returned by  nextvar
    psei: ISEIndex _ NextVar[ssei];
    rsei: ISEIndex;

    IF psei = sei THEN RETURN [psei];
    UNTIL psei = sei DO
      rsei _ psei; psei _ NextVar[SymbolOps.NextSe[psei]]; ENDLOOP;
    RETURN [rsei];
    END;

  PushLitVal: PUBLIC PROCEDURE [v: UNSPECIFIED] =
    BEGIN -- forces a constant onto the stack
    Out1[FOpCodes.qLI, v];
    RETURN
    END;


  SetCodeIndex: PUBLIC PROCEDURE [i: SymbolSegment.ByteIndex] =
    BEGIN
    codeindex _ i;
    END;

  TreeLiteral: PUBLIC PROCEDURE [t: Tree.Link] RETURNS [BOOLEAN] =
    BEGIN
    node: Tree.Index;
      DO
      WITH t SELECT FROM
	literal => RETURN[info.litTag = word];
	subtree =>
	  BEGIN  node _ index;
	  SELECT tb[node].name FROM
	    cast, mwconst =>  t _ tb[node].son[1];
	    ENDCASE => RETURN [FALSE];
	  END;
	ENDCASE => RETURN[FALSE]
      ENDLOOP
    END;

  TreeLiteralValue: PUBLIC PROCEDURE [t: Tree.Link] RETURNS [WORD] =
    BEGIN
    node: Tree.Index;
      DO
      WITH e:t SELECT FROM
	literal =>
	  WITH e.info SELECT FROM
	    word => RETURN [LiteralOps.Value[index]];
	    ENDCASE => EXIT;
	subtree =>
	  BEGIN  node _ e.index;
	  SELECT tb[node].name FROM
	    cast, mwconst =>  t _ tb[node].son[1];
	    ENDCASE => EXIT;
	  END;
	ENDCASE => EXIT
      ENDLOOP;
    P5.P5Error[261];  -- never comes back
    RETURN[0]
    END;

  UnMonitor: PROCEDURE [cell: CCIndex, action: MonitorAction] =
    BEGIN
    p, q: POINTER TO MonitorRecord;
    IF monList = NIL THEN RETURN;
    IF monList.cell = cell AND monList.action = action THEN
      BEGIN p _ monList.next; SystemDefs.FreeHeapNode[monList];
      monList _ p;
      END;
    FOR p _ monList, p.next UNTIL p.next = NIL DO
      IF p.next.cell = cell AND p.next.action = action THEN
	BEGIN
	q _ p.next.next;
	SystemDefs.FreeHeapNode[p.next];
	p.next _ q;
	RETURN;
	END;
      ENDLOOP;
    END;

  WordAligned: PUBLIC PROCEDURE [tsei: RecordSEIndex] RETURNS [BOOLEAN] =
    BEGIN -- sees if a word-aligned record (never TRUE for a variant record)
	  -- always true for an argument record
    sei: ISEIndex;
    wa: INTEGER _ 0;
    a: BitAddress;

    tsei _ RecordRoot[tsei];
    IF seb[tsei].hints.variant THEN RETURN[FALSE];
    IF seb[tsei].argument THEN RETURN[TRUE];
    sei _ NextVar[ctxb[seb[tsei].fieldCtx].seList];
    UNTIL sei = ISENull DO
      a _ seb[sei].idValue;
      IF a.bd # 0 THEN RETURN[FALSE];
      IF a.wd < wa THEN RETURN [FALSE];
      wa _ a.wd;
      sei _ NextVar[NextSe[sei]];
      ENDLOOP;
    RETURN[TRUE]
    END;

  WordsForOperand: PUBLIC PROCEDURE [t: Tree.Link] RETURNS [n: CARDINAL] =
    BEGIN -- compute number of words for storing value of tree
    WITH t SELECT FROM
      literal => n _ 1; -- multiwords will be subtrees
      symbol => n _ WordsForSei[seb[index].idType];
      subtree => n _ WordsForType[OperandType[t]];
      ENDCASE;
    RETURN
    END;

  WordsForSei: PUBLIC PROCEDURE [sei: SEIndex] RETURNS [CARDINAL] =
    BEGIN
    RETURN [IF sei = SENull THEN 0 
	ELSE SymbolOps.WordsForType[UnderType[sei]]];
    END;



  END.