-- Driver.mesa, last modified by Sweet, January 15, 1980  3:18 PM

DIRECTORY
  AltoDefs: FROM "altodefs" USING [BYTE, wordlength],
  Code: FROM "code" USING [
    actenable, bodyComRetLabel, bodyInRecord, bodyOutRecord, bodyRetLabel, 
    caseCVState, catchcount, catchoutrecord, codeptr, curctxlvl, dStar, 
    fileindex, framesz, inlineFileIndex, mainBody, StackNotEmptyAtStatement, 
    tempcontext, tempstart, xtracting],
  CodeDefs: FROM "codedefs" USING [
    AddressNotify, AJumpsNotify, CallsNotify, CCIndex, CCNull, CgenUtilNotify, 
    ConstructorNotify, CrossJumpNotify, DJumpsNotify, ExpressionNotify, 
    FinalNotify, FlowExpressionNotify, FlowNotify, JumpCCNull, LabelCCIndex, 
    LabelCCNull, Lexeme, MaxParmsInStack, NULLfileindex, NullLex, 
    OutCodeNotify, PeepholeNotify, StackImplNotify, StatementNotify, 
    StatementStateRecord, StoreNotify, TempNotify, VarBasicsNotify, VarIndex, 
    VarMoveNotify, VarUtilsNotify],
  ComData: FROM "comdata" USING [
    bodyIndex, bodyRoot, mainBody, nErrors, objectBytes, objectFrameSize, 
    stopping, switches, textIndex],
  ControlDefs: FROM "controldefs" USING [globalbase, localbase],
  FOpCodes: FROM "fopcodes" USING [
    qLADRB, qLI, qLINKB, qLL, qME, qMEL, qMXD, qMXDL, qRET, qSG],
  P5: FROM "p5" USING [
    BuildArgRecord, EndCodeFile, Exp, ExtractFrom, Fixup, LogHeapFree, 
    OutBinary, PopStatementState, PRetLex, ProcessGlobalStrings, 
    ProcessLocalStrings, PurgePendTempList, PushStatementState, StartCodeFile, 
    StatementTree, SysError, TempInit],
  P5L: FROM "p5l" USING [
    LoadAddress, TOSAddrLex, TOSLex, VarFinal, VarForLex],
  P5S: FROM "p5s",
  P5U: FROM "p5u" USING [
    CgenUtilInit, CreateLabel, DeleteCell, InsertLabel, LabelAlloc, NextVar, 
    OperandType, Out0, Out1, OutJump, PushLitVal, SetCodeIndex, WordsForSei],
  Stack: FROM "stack" USING [
    Decr, Depth, Dump, Incr, Init, Load, Off, On, Reset, Top],
  SymbolOps: FROM "symbolops" USING [NextSe, TransferTypes],
  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],
  Table: FROM "table" USING [Base, Notifier],
  Tree: FROM "tree" USING [Index, Link, Null, treeType],
  TreeOps: FROM "treeops" USING [
    FreeNode, MakeList, MakeNode, PushList, PushNode, PushSe, PushTree, 
    ScanList];

Driver: PROGRAM
    IMPORTS MPtr: ComData, LCPtr: Code, P5U, CodeDefs, P5L, P5, Stack,
      SymbolOps, TreeOps 
    EXPORTS CodeDefs, P5, P5S =
  BEGIN
  OPEN CodeDefs;
  CPtr: POINTER TO FRAME[Code] = LCPtr;

  -- imported definitions

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

  localbase: CARDINAL = ControlDefs.localbase;
  globalbase: CARDINAL = ControlDefs.globalbase;

  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)

  DriverNotify: 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];
    CgenUtilNotify[base]; 
    AddressNotify[base];
    ExpressionNotify[base];
    FlowExpressionNotify[base];
    FlowNotify[base];
    StackImplNotify[base];
    TempNotify[base];
    StatementNotify[base];
    ConstructorNotify[base];
    StoreNotify[base];
    CallsNotify[base];
    OutCodeNotify[base];
    FinalNotify[base];
    CrossJumpNotify[base];
    AJumpsNotify[base];
    DJumpsNotify[base];
    PeepholeNotify[base]; 
    VarUtilsNotify[base];
    VarBasicsNotify[base];
    VarMoveNotify[base];
    RETURN
    END;


  codestart: CCIndex;
  mlock: Tree.Link;
  longlock: BOOLEAN;

  Module: PUBLIC PROCEDURE =
    BEGIN -- main driver for code generation
    bti, prev: BTIndex;

    CPtr.bodyInRecord _ CPtr.bodyOutRecord _ RecordSENull;
    P5U.CgenUtilInit[];
    P5.TempInit[];
    Stack.Init[];
    Stack.Off[];
    CPtr.inlineFileIndex _ NULLfileindex;
    CPtr.xtracting _ FALSE;
    CPtr.caseCVState _ none;
    CPtr.catchoutrecord _ RecordSENull;
    CPtr.catchcount _ 0;
    CPtr.actenable _ LabelCCNull;
    CPtr.codeptr_ codestart _ CCNull;
    CPtr.dStar _ ~MPtr.switches['a];
    P5.StartCodeFile[];
    bti _ MPtr.bodyRoot;
    DO
      WITH bb[bti] SELECT FROM
	Callable => IF ~inline THEN Body[LOOPHOLE[bti]];
	ENDCASE;
      IF bb[bti].firstSon # BTNull
	THEN bti _ bb[bti].firstSon
	ELSE
	  DO
	  prev _ bti;  bti _ bb[bti].link.index;
	  IF bti = BTNull THEN GO TO Done;
	  IF bb[prev].link.which # parent THEN EXIT;
	  ENDLOOP;
      REPEAT
	Done => NULL;
      ENDLOOP;
    MPtr.objectBytes _ P5.EndCodeFile[];
    Stack.Reset[];
    P5L.VarFinal[];
    RETURN;
    END;


  Body: PROCEDURE [bti: CBTIndex] =
    BEGIN -- produces code for body
    psei: CSEIndex _ bb[bti].ioType;
    bodynode: Tree.Index;

   CPtr.mainBody _ bti = MPtr.mainBody;
   MPtr.bodyIndex _ bti;

   WITH bi: bb[bti].info SELECT FROM
    Internal =>
    BEGIN
    MPtr.textIndex _ bi.sourceIndex;
    bodynode _ bi.bodyTree;
    CPtr.curctxlvl _ bb[bti].level;

    -- set up input and output contexts
    [CPtr.bodyInRecord, CPtr.bodyOutRecord] _ SymbolOps.TransferTypes[psei];

    IF CPtr.mainBody THEN
      BEGIN
      MPtr.objectFrameSize _ bi.frameSize;
      bi.frameSize _ localbase;
      CPtr.curctxlvl _ lL;
      END;
    CPtr.tempstart _ CPtr.framesz _ bi.frameSize;
    P5U.SetCodeIndex[CPtr.fileindex _ bi.sourceIndex];

    -- init the code stream and put down bracketing labels

    CPtr.bodyRetLabel _ P5U.LabelAlloc[];
    CPtr.bodyComRetLabel _ P5U.LabelAlloc[];
    CPtr.codeptr _ CCNull;
    codestart _ P5U.CreateLabel[];

    -- init data for creating temporaries

    ctxb[CPtr.tempcontext].level _ CPtr.curctxlvl;

    -- tuck parameters away into the frame

    IF Stack.Depth[] # 0 THEN SIGNAL CPtr.StackNotEmptyAtStatement;
    WITH bb[bti] SELECT FROM
     Inner => BEGIN
	      P5U.Out1[FOpCodes.qLINKB, frameOffset-localbase];
	      END;
     ENDCASE;
    Stack.On[];
    PopInVals[CPtr.bodyInRecord, FALSE];
    P5.PurgePendTempList[];

        -- do string literals
 
    IF CPtr.mainBody THEN 
      MPtr.objectFrameSize _ P5.ProcessGlobalStrings[MPtr.objectFrameSize];
    CPtr.tempstart _ P5.ProcessLocalStrings[CPtr.tempstart, bi.thread];
    bi.frameSize _ CPtr.framesz _ MAX [CPtr.framesz, CPtr.tempstart];

	-- do initialization code and main body

    IF CPtr.mainBody AND MPtr.stopping THEN
      BEGIN OPEN FOpCodes;
      P5U.Out1[qLADRB, 0];
      P5U.Out1[qSG, globalbase];
      END;

    IF tb[bodynode].attr1 THEN SetLock[tb[bodynode].son[4]]
    ELSE mlock _ Tree.Null;

    -- generate code for declaration initializations and statements

    tb[bodynode].son[2] _ P5.StatementTree[tb[bodynode].son[2]];
    tb[bodynode].son[3] _ P5.StatementTree[tb[bodynode].son[3]];
    tb[bodynode].son[1] _ Tree.Null;
    IF Stack.Depth[] # 0 THEN SIGNAL CPtr.StackNotEmptyAtStatement;

    -- push the return values onto the stack

    InsertRetLabels[mlock # Tree.Null];
    Stack.Reset[];
    IF CPtr.mainBody AND MPtr.stopping THEN
	BEGIN P5U.Out1[FOpCodes.qLI, 0]; P5U.Out1[FOpCodes.qSG, globalbase]; END;
    Stack.Off[];
    P5U.Out0[FOpCodes.qRET];
    P5.PurgePendTempList[];

    -- write frame size into bodyitem

    bi.frameSize _ CPtr.framesz;

    -- fixup jumps

    IF MPtr.nErrors = 0 THEN P5.Fixup[codestart];

	-- output the object code

    P5U.SetCodeIndex[NULLfileindex];
    TreeOps.FreeNode[bodynode];
    IF MPtr.nErrors = 0 THEN P5.OutBinary[bti, codestart]
    ELSE
      BEGIN
      c, next: CCIndex;
      FOR c _ codestart, next WHILE c # CCNull DO
	next _ cb[c].flink;
	P5U.DeleteCell[c];
	ENDLOOP;
      END;
    END;
    ENDCASE;
    RETURN
    END;

  SSubst: PROCEDURE [node: Tree.Index] RETURNS [nrets: CARDINAL] =
    BEGIN
    ss: StatementStateRecord;
    tsei: CSEIndex _ P5U.OperandType[tb[node].son[1]];
    P5.PushStatementState[@ss];
    CPtr.bodyOutRecord _ SymbolOps.TransferTypes[tsei].typeOut;
    tb[node].son[2] _ P5.StatementTree[tb[node].son[2]];
    IF Stack.Depth[] # 0 THEN SIGNAL CPtr.StackNotEmptyAtStatement;
    InsertRetLabels[FALSE]; -- if entry procedure, lock already dealt with
    Stack.Reset[];
    nrets _ P5U.WordsForSei[CPtr.bodyOutRecord];
    P5.PopStatementState[@ss];
    END;

  InsertRetLabels: PROCEDURE [monitored: BOOLEAN] =
    BEGIN
    IF CPtr.bodyComRetLabel = LabelCCNull THEN RETURN;
    P5U.InsertLabel[CPtr.bodyComRetLabel];
    IF monitored THEN ReleaseLock[];
    IF cb[CPtr.bodyComRetLabel].jumplist # JumpCCNull THEN PushRetVals[];
    P5U.InsertLabel[CPtr.bodyRetLabel];
    CPtr.bodyComRetLabel _ LabelCCNull;
    CPtr.bodyRetLabel _ LabelCCNull;
    END;


  Subst: PUBLIC PROCEDURE [node: Tree.Index] =
    BEGIN
    [] _ SSubst[node];
    END;

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

  PopInVals: PUBLIC PROCEDURE [irecord: RecordSEIndex, isenable: BOOLEAN] =
    BEGIN
    nparms: CARDINAL;
    r: VarIndex;
    t: Tree.Link;
    sei: ISEIndex;
    np: CARDINAL _ 0;

    IF irecord = CSENull THEN RETURN;
    nparms _ P5U.WordsForSei[irecord];
    IF nparms = 0 THEN RETURN;
    IF isenable THEN
      IF nparms <= 1 THEN RETURN
      ELSE P5U.Out1[FOpCodes.qLL,localbase+1];
    sei _ P5U.NextVar[ctxb[seb[irecord].fieldCtx].seList];
    UNTIL sei = ISENull DO
      OPEN TreeOps;
      PushSe[sei]; PushTree[Tree.Null]; PushNode[assign, 2];
      np _ np+1;
      sei _ P5U.NextVar[SymbolOps.NextSe[sei]];
      ENDLOOP;
    TreeOps.PushList[np];
    t _ TreeOps.MakeNode[exlist, 1];

    IF nparms > MaxParmsInStack OR (isenable AND nparms > 1) THEN
      BEGIN
      IF ~isenable THEN Stack.Incr[1];
      r _ P5L.TOSAddrLex[nparms].lexbdoi;
      END
    ELSE
      BEGIN
      Stack.Incr[nparms];
      r _ P5L.VarForLex[P5L.TOSLex[nparms]];
      END;
    P5.ExtractFrom[t, irecord, r, (nparms > MaxParmsInStack AND ~isenable)];
    RETURN
    END;


  PushRetVals: PROCEDURE =
    BEGIN -- pushes the return vals from a body onto the stack
    sei: ISEIndex;
    nretvals: CARDINAL;
    np: CARDINAL _ 0;
    t: Tree.Link;

    IF CPtr.bodyOutRecord = CSENull THEN RETURN;
    nretvals _ P5U.WordsForSei[CPtr.bodyOutRecord];
    sei _ ctxb[seb[CPtr.bodyOutRecord].fieldCtx].seList;
    UNTIL sei = ISENull DO
      OPEN TreeOps;
      PushSe[sei];
      np _ np+1;
      sei _ P5U.NextVar[SymbolOps.NextSe[sei]];
      ENDLOOP;
    t _ TreeOps.MakeList[np];
    sei _ ctxb[seb[CPtr.bodyOutRecord].fieldCtx].seList;
    IF seb[P5U.NextVar[sei]].hash = HTNull THEN -- anonymous RETURNS list
      BEGIN
      P5.SysError[];
      RETURN
      END;
    [] _ P5.BuildArgRecord[t, CPtr.bodyOutRecord, FALSE];
    RETURN
    END;

  SetLock: PROCEDURE [lock: Tree.Link] =
    BEGIN
    retryentry: LabelCCIndex _ P5U.CreateLabel[];
    longlock _ P5L.LoadAddress[P5L.VarForLex[P5.Exp[(mlock _ lock)]]];
    P5U.Out0[IF longlock THEN FOpCodes.qMEL 
      ELSE FOpCodes.qME];
    P5U.Out1[FOpCodes.qLI, 0];
    P5U.OutJump[JumpE, retryentry];
    END;


  ReleaseLock: PUBLIC PROCEDURE =
    BEGIN
    Stack.Dump[];
    [] _ P5L.LoadAddress[P5L.VarForLex[P5.Exp[mlock]]];
    P5U.Out0[IF longlock THEN FOpCodes.qMXDL ELSE FOpCodes.qMXD];
    RETURN
    END;


  SReturn: PROCEDURE [node: Tree.Index, isresume: BOOLEAN] =
    BEGIN -- generate code for RETURN and RESUME
    nretvals: CARDINAL;
    nstack: CARDINAL;
    rsei: RecordSEIndex;
    monitored: BOOLEAN;

    IF ~isresume AND CommonRet[tb[node].son[1]] THEN
      BEGIN
      P5U.OutJump[Jump, CPtr.bodyComRetLabel];
      RETURN
      END;

    monitored _ ~isresume AND tb[node].attr1;
    IF monitored AND tb[node].attr2 THEN
      BEGIN ReleaseLock[]; monitored _ FALSE; END;
    rsei _ IF isresume THEN CPtr.catchoutrecord ELSE CPtr.bodyOutRecord;
    nretvals _ P5.BuildArgRecord[tb[node].son[1], rsei, isresume, isresume];
    nstack _ 
      IF nretvals > MaxParmsInStack OR isresume AND nretvals # 0 THEN 1
      ELSE nretvals;

    IF monitored THEN
      BEGIN
      Stack.Dump[]; ReleaseLock[];
      END;
    IF nstack # 0 THEN
      BEGIN
      Stack.Load[Stack.Top[nstack], nstack];
      Stack.Decr[nstack]; -- remove from model
      END;
    IF isresume THEN 
      BEGIN
      P5U.PushLitVal[1]; Stack.Decr[1];
      P5U.Out0[FOpCodes.qRET]; 
      P5U.OutJump[JumpRet, LabelCCNull]; 
      END
    ELSE P5U.OutJump[Jump, CPtr.bodyRetLabel];
    RETURN
    END;


  Result: PUBLIC PROCEDURE [node: Tree.Index] =
    BEGIN -- produce code for RETURN
    SReturn[node, FALSE]; -- let outer statement catch LogHeapFree
    RETURN
    END;

  Return: PUBLIC PROCEDURE [node: Tree.Index] =
    BEGIN -- produce code for RETURN
    SReturn[node, FALSE !P5.LogHeapFree => RESUME[FALSE, NullLex]]; RETURN
    END;


  Resume: PUBLIC PROCEDURE [node: Tree.Index] =
    BEGIN -- produce code for RESUME
    SReturn[node, TRUE !P5.LogHeapFree => RESUME[FALSE, NullLex]]; RETURN
    END;


  CommonRet: PROCEDURE [t: Tree.Link] RETURNS [common: BOOLEAN] =
    BEGIN -- test if the returns list duplicats the returns declaration
    sei: ISEIndex;
    scr: PROCEDURE [t: Tree.Link] =
      BEGIN
      IF ~common THEN RETURN;
      WITH t SELECT FROM
	literal => common _ FALSE;
	symbol => common _ sei = index;
	subtree => common _ FALSE;
	ENDCASE;
      IF sei # SENull THEN sei _ P5U.NextVar[SymbolOps.NextSe[sei]];
      RETURN
      END;

    common _ TRUE;
    IF t = Tree.Null THEN RETURN;
    IF CPtr.bodyOutRecord # CSENull THEN
      sei _ P5U.NextVar[ctxb[seb[CPtr.bodyOutRecord].fieldCtx].seList]
    ELSE RETURN [FALSE];
    TreeOps.ScanList[t, scr];
    RETURN
    END;

  Lock: PUBLIC PROCEDURE [node: Tree.Index] =
    BEGIN
    saveLock: Tree.Link _ mlock;
    SetLock[tb[node].son[2]];
    tb[node].son[1] _ P5.StatementTree[tb[node].son[1]];
    InsertRetLabels[TRUE]; -- we are in an INLINE procedure
    mlock _ saveLock;
    END;



END...
(1792)\12353f1 2f0