-- CGenDebugGlobals.mesa  Edited by Bruce, September 22, 1980  10:55 AM

DIRECTORY
  AllocDebugDefs USING [],
  AltoDefs USING [wordlength],
  CGenDebugDefs USING [ccInfo, cd, UpdateConstDest],
  CGenDebugGlobalDefs USING [
    AllocatorbaseOffset, AllocatortopOffset, CodecodeptrOffset, 
    CodecurctxlvlOffset, CodeframeszOffset, CodestkingOffset, 
    CodetempcontextOffset, CodetempstartOffset, ComDatabodyIndexOffset, 
    ComDatasourceFileOffset, ComDatatextIndexOffset, ConstructorcdOffset, 
    DrivercodestartOffset, ExpressionrecentExpOffset, FinalccInfoOffset, 
    FlowlabelStackOffset, StackImplstkHeadOffset, StackImplstkPtrOffset, 
    StatementrecentStmtOffset, TempheapListOffset, TemppendTempListOffset],
  CodeDefs USING [
    CCIndex, CCInfoType, ConsDestination, LabelInfoIndex, StackIndex, 
    StackItem, StackNull],
  ControlDefs USING [GlobalFrameHandle],
  DebugUsefulDefs USING [Enumerate, Name, ShortCopyREAD, ShortREAD, window],
  Event USING [AddNotifier, Item, Masks, Notifier],
  IODefs USING [ControlZ, CR],
  OpCodeParams USING [GlobalBase, GlobalLoadSlots, LocalBase, LocalLoadSlots],
  Process USING [Detach, Yield],
  RESOut USING [
    cancelAction, Complain, PChar, PCr, PNext, PNextUnsigned, POctal, PString, 
    PUnsigned],
  SegmentDefs USING [FileNameError],
  StreamDefs USING [
    GetIndex, ModifyIndex, NewByteStream, NormalizeIndex, Read, SetIndex, 
    StreamHandle, StreamIndex],
  StringDefs USING [AppendChar, AppendDecimal, AppendString, CompareStrings],
  Symbols USING [
    BitAddress, ContextLevel, CTXRecord, ctxType, ISEIndex, ISENull, lG, lZ, 
    SERecord, seType],
  Storage USING [String, FreeString],
  Table USING [Base, chunkType, Selector],
  UserInput USING [
    CancelPeriodicNotify, CreatePeriodicNotify, PeriodicNotifyHandle, 
    PeriodicProcType];

CGenDebugGlobals: PROGRAM 
  IMPORTS CGenDebugDefs, DebugUsefulDefs, Event, Process, RESOut, 
    SegmentDefs, StreamDefs, StringDefs, Storage, UserInput
  EXPORTS CGenDebugDefs, AllocDebugDefs =
  BEGIN OPEN CodeDefs, DebugUsefulDefs, RESOut, CGenDebugDefs, CGenDebugGlobalDefs;

  basesValid: BOOLEAN _ FALSE;
  al: POINTER _ NIL;
  constructor: POINTER _ NIL;
  CPtr: POINTER _ NIL;
  driver: POINTER _ NIL;
  expression: POINTER _ NIL;
  final: POINTER _ NIL;
  flow: POINTER _ NIL;
  MPtr: POINTER _ NIL;
  stack: POINTER _ NIL;
  statement: POINTER _ NIL;
  temp: POINTER _ NIL;

  StackBottom: PUBLIC PROCEDURE RETURNS [StackIndex] =
    BEGIN OPEN CodeDefs;
    sHead: StackIndex;
    sir: StackItem;
    cb: Table.Base = TableBase[];
    IF stack = NIL THEN
      BEGIN
      RESOut.Complain["Base of StackImpl unknown"L];
      ERROR cancelAction;
      END;
    sHead _ ShortREAD[stack+StackImplstkHeadOffset];
    IF sHead = StackNull THEN RETURN [StackNull];
    ShortCopyREAD[to: @sir, from: @cb[sHead], nwords: SIZE[StackItem]];
    RETURN [sir.uplink];
    END;

  StackState: PUBLIC PROCEDURE RETURNS [BOOLEAN] =
    BEGIN
    IF stack = NIL THEN
      BEGIN
      RESOut.Complain["Base of StackImpl unknown"L];
      ERROR cancelAction;
      END;
    RETURN [ShortREAD[CPtr+CodestkingOffset]];
    END;

  StackTop: PUBLIC PROCEDURE RETURNS [StackIndex] =
    BEGIN OPEN CodeDefs;
    IF stack = NIL THEN
      BEGIN
      RESOut.Complain["Base of StackImpl unknown"L];
      ERROR cancelAction;
      END;
    RETURN [ShortREAD[stack+StackImplstkPtrOffset]];
    END;

  PutTempState: PUBLIC PROCEDURE =
    BEGIN OPEN Symbols;
    seb: Table.Base = TableBase[seType];
    ser: id SERecord;
    name: STRING _ [20];

    ShowList: PROCEDURE [sei: ISEIndex, heading: STRING] =
      BEGIN
      first: BOOLEAN _ TRUE;
      IF sei = ISENull THEN RETURN;
      PCr[]; PString["    "L];
      PString[heading]; PString[": {"L];
      WHILE sei # ISENull DO
        ShortCopyREAD[to: @ser, from: @seb[sei], nwords: SIZE[id SERecord]];
	GetVarName[name, sei];
	IF first THEN PString[name] ELSE PNext[name,,6];
	first _ FALSE;
	WITH ser SELECT FROM
	  linked => sei _ link;
	  ENDCASE => sei _ ISENull;
	ENDLOOP;
      PChar['}];
      END;

    IF temp = NIL THEN
      BEGIN
      RESOut.Complain["Base of Temp unknown"L];
      ERROR cancelAction;
      END;
    PCr[];
    PString["Temp ctx: "L]; PUnsigned[ShortREAD[CPtr+CodetempcontextOffset]];
    PNextUnsigned["start"L, ShortREAD[CPtr+CodetempstartOffset]];
    PNextUnsigned["framesz"L, ShortREAD[CPtr+CodeframeszOffset]];
    ShowList[ShortREAD[temp+TemppendTempListOffset], "Pending"L];
    ShowList[ShortREAD[temp+TempheapListOffset], "Heap"L];
    END;

  GetVarName: PROCEDURE [s: STRING, sei: Symbols.ISEIndex] =
    BEGIN OPEN StringDefs, Symbols;
    ctxb: Table.Base = TableBase[ctxType];
    seb: Table.Base = TableBase[seType];
    ser: id SERecord;
    ctr: CTXRecord;
    addr: BitAddress;

    ShortCopyREAD[to: @ser, from: @seb[sei], nwords: SIZE [id SERecord]];
    ShortCopyREAD[to: @ctr, from: @ctxb[ser.idCtx], nwords: SIZE[CTXRecord]];

    addr _ ser.idValue;
    s.length _ 0;
    GetFrameName[s, addr.wd, ctr.level,
	CARDINAL[ser.idInfo+AltoDefs.wordlength-1]/AltoDefs.wordlength];
    END;


  GetFrameName: PUBLIC PROCEDURE [s: STRING,
      wd: CARDINAL, level: Symbols.ContextLevel, wSize: CARDINAL] =
    BEGIN OPEN StringDefs, Symbols;
    curlvl: ContextLevel = CurContext[];
    levadj: STRING _ [10];

    SELECT level FROM
      lZ => AppendString[s, "Field "L];
      lG => AppendChar[s, 'G];
      curlvl => AppendChar[s, 'L];
      ENDCASE =>
	BEGIN
	AppendChar[s, 'L];
	AppendString[levadj,"(up "L];
	AppendDecimal[levadj, curlvl-level];
	AppendChar[levadj,')];
	END;
    SELECT level FROM
      lZ => NULL;
      lG => IF wd IN OpCodeParams.GlobalLoadSlots THEN 
	  wd _ wd - OpCodeParams.GlobalBase
	ELSE AppendString[s, "B "L]; 
      ENDCASE => IF wd IN OpCodeParams.LocalLoadSlots THEN 
	  wd _ wd - OpCodeParams.LocalBase
	ELSE AppendString[s, "B "L]; 
    AppendDecimal[s, wd];
    IF wSize > 1 THEN 
      BEGIN
      AppendString[s, ".."L];
      AppendDecimal[s, wd + wSize - 1];
      END;
    AppendString[s, levadj];
    END;

  TableBase: PUBLIC PROCEDURE [table: Table.Selector _ Table.chunkType]
      RETURNS [Table.Base] =
    BEGIN
    base: DESCRIPTOR FOR ARRAY Table.Selector OF Table.Base;

    IF al = NIL THEN
      BEGIN
      RESOut.Complain["Base of Allocator unknown"L];
      ERROR cancelAction;
      END;
    ShortCopyREAD[to: @base, from: al+AllocatorbaseOffset, nwords: 
      SIZE[DESCRIPTOR FOR ARRAY Table.Selector OF Table.Base]];
    RETURN [ShortREAD[@base[table]]];
    END;

  TableSize: PUBLIC PROCEDURE [table: Table.Selector _ Table.chunkType]
      RETURNS [CARDINAL] =
    BEGIN
    top: DESCRIPTOR FOR ARRAY Table.Selector OF CARDINAL;

    IF al = NIL THEN
      BEGIN
      RESOut.Complain["Base of Allocator unknown"L];
      ERROR cancelAction;
      END;
    DebugUsefulDefs.ShortCopyREAD[to: @top, from: al+AllocatortopOffset, nwords: 
      SIZE[DESCRIPTOR FOR ARRAY Table.Selector OF CARDINAL]];
    RETURN [ShortREAD[@top[table]]];
    END;

-- following two procedures should be called from StringDefs
--  whenever CompareStrings gets fixed

  UpperCase: PROCEDURE [c: CHARACTER] RETURNS [CHARACTER] = 
    BEGIN
    IF c IN ['a..'z] THEN c _ c + ('A-'a);
    RETURN[c]
    END;

  nMods: CARDINAL = 11;
  LookForFrames: PROCEDURE =
    BEGIN
    moduleName: ARRAY [0..nMods) OF STRING _ [
      "Allocator"L, "Code"L, "ComData"L, "Constructor"L, "Driver"L,
      "Expression"L, "Final"L, "Flow"L, "StackImpl"L, "Statement"L, "Temp"L];
    basePtr: ARRAY [0..nMods) OF POINTER _ [
      @al, @CPtr, @MPtr, @constructor, @driver,
      @expression, @final, @flow, @stack, @statement, @temp];
    keyString: STRING = [40];
    firstOut: BOOLEAN _ TRUE;
    i, nFound: CARDINAL;

    CheckOneFrame: PROCEDURE [han: ControlDefs.GlobalFrameHandle]
	RETURNS [BOOLEAN] =
      BEGIN
      l, u, i: CARDINAL;
      name: POINTER TO ARRAY [0..nMods) OF STRING = @moduleName;
      base: POINTER TO ARRAY [0..nMods) OF POINTER = @basePtr;
      key: STRING = keyString;

      key.length _ 0;
      DebugUsefulDefs.Name[name: key, gf: han];
      l _ 0; u _ nMods-1;
      WHILE l <= u DO
	i _ (l+u)/2;
        SELECT StringDefs.CompareStrings[key, name[i], FALSE] FROM
	  < 0 => u _ i-1;
	  > 0 => l _ i+1;
	  ENDCASE =>
	    BEGIN
	    IF base[i]^ = NIL THEN
	      BEGIN base[i]^ _ han; nFound _ nFound + 1 END
	    ELSE
	      BEGIN
	      IF firstOut THEN
		BEGIN
		firstOut _ FALSE;
		RESOut.Complain["Duplicate: "L];
		END
	      ELSE RESOut.Complain[", "L, FALSE];
	      RESOut.Complain[key, FALSE];
	      END;
	    EXIT
	    END;
        ENDLOOP;
      Process.Yield[];
      RETURN[nFound = nMods];
      END;

    FOR i IN [0..nMods) DO basePtr[i]^ _ NIL; ENDLOOP;
    nFound _ 0;
    [] _ DebugUsefulDefs.Enumerate[CheckOneFrame];
    IF nFound # nMods THEN
      BEGIN
      IF ~firstOut THEN RESOut.Complain[", "L, FALSE];
      RESOut.Complain["Missing: "L, ~firstOut];
      firstOut _ TRUE;
      FOR i IN [0..nMods) DO
	IF basePtr[i]^ = NIL THEN
	  BEGIN
	  IF firstOut THEN firstOut _ FALSE
	  ELSE RESOut.Complain[", "L, FALSE];
	  RESOut.Complain[moduleName[i], FALSE];
	  END;
        ENDLOOP;
      END;
    CopyGlobalData[];
    END;


  FindFrames: PUBLIC PROCEDURE =
    BEGIN
    END;

  CurContext: PUBLIC PROCEDURE RETURNS [Symbols.ContextLevel] =
    BEGIN
    IF CPtr = NIL THEN 
      BEGIN
      RESOut.Complain["Base of Code unknown"L];
      ERROR cancelAction;
      END;
    RETURN [ShortREAD[CPtr+CodecurctxlvlOffset]];
    END;

  CCCur: PUBLIC PROCEDURE RETURNS [CodeDefs.CCIndex] =
    BEGIN
    IF CPtr = NIL THEN 
      BEGIN
      RESOut.Complain["Base of Code unknown"L];
      ERROR cancelAction;
      END;
    RETURN [ShortREAD[CPtr+CodecodeptrOffset]];
    END;

  CCFirst: PUBLIC PROCEDURE RETURNS [CodeDefs.CCIndex] =
    BEGIN
    IF driver = NIL THEN 
      BEGIN
      RESOut.Complain["Base of Driver unknown"L];
      ERROR cancelAction;
      END;
    RETURN [ShortREAD[driver+DrivercodestartOffset]];
    END;

  LabelStack: PUBLIC PROCEDURE RETURNS [CodeDefs.LabelInfoIndex] =
    BEGIN
    IF flow = NIL THEN 
      BEGIN
      RESOut.Complain["Base of Driver unknown"L];
      ERROR cancelAction;
      END;
    RETURN [ShortREAD[flow+FlowlabelStackOffset]];
    END;

  PutCurrentBody: PUBLIC PROCEDURE =
    BEGIN
    IF MPtr = NIL THEN 
      BEGIN
      RESOut.Complain["Base of ComData unknown"L];
      ERROR cancelAction;
      END;
    PCr[];
    PString["Current body bti = "L];
    PUnsigned[ShortREAD[MPtr+ComDatabodyIndexOffset]]; 
    END;

  PutCurrentSource: PUBLIC PROCEDURE =
    BEGIN
    index: CARDINAL;
    IF sourceName # NIL THEN Storage.FreeString[sourceName];
    IF MPtr = NIL THEN 
      BEGIN
      RESOut.Complain["Base of ComData unknown"L];
      ERROR cancelAction;
      END;
    sourceName _ CopyUserString[ShortREAD[MPtr+ComDatasourceFileOffset]];
    index _ ShortREAD[MPtr+ComDatatextIndexOffset];
    PCr[];
    PString["Current source: "L]; PString[sourceName];
    PString[" ["L]; POctal[index]; PChar[']];
    IF index # LAST[CARDINAL] THEN
      BEGIN
      PCr[];
      PrintTextLine[sourceName, index];
      END;
    END;

  sourceName: STRING _ NIL;
  firstPrinted, lastPrinted: StreamDefs.StreamIndex _ [0,0];

  PrintNextLine: PUBLIC PROCEDURE =
    BEGIN OPEN StreamDefs, IODefs;
    in: StreamHandle;
    ch: CHARACTER;

    IF sourceName = NIL THEN RETURN;
    in _ NewByteStream[sourceName, Read ! SegmentDefs.FileNameError =>
	GO TO bad];
    SetIndex[in, lastPrinted];
    IF in.endof[in] THEN RETURN;
    ch _ in.get[in];
    IF ch = ControlZ THEN
      WHILE ~in.endof[in] AND in.get[in] # CR DO ENDLOOP;
    IF in.endof[in] THEN RETURN;
    PCr[];
    firstPrinted _ lastPrinted _ GetIndex[in];
    THROUGH [0..80] WHILE ~in.endof[in] DO
      lastPrinted _ GetIndex[in];
      SELECT (ch _ in.get[in]) FROM
	CR, ControlZ => EXIT;
	ENDCASE => PChar[ch];
      ENDLOOP;
    EXITS
      bad =>
	BEGIN
	RESOut.Complain["Bad File Name"L];
	ERROR cancelAction;
	END;
    END;

  PrintPrevLine: PUBLIC PROCEDURE =
    BEGIN OPEN StreamDefs, IODefs;
    in: StreamHandle;
    ch: CHARACTER;
    again: BOOLEAN;
    lineIndex: StreamIndex;

    IF sourceName = NIL OR firstPrinted = [0,0] THEN RETURN;
    in _ NewByteStream[sourceName, Read ! SegmentDefs.FileNameError =>
	GO TO bad];
    lineIndex _ lastPrinted _ firstPrinted _ ModifyIndex[firstPrinted, -1];
    again _ TRUE;
    WHILE again DO
      again _ FALSE;
      THROUGH [1..80] UNTIL lineIndex = [0, 0]
        DO
        lineIndex _ ModifyIndex[lineIndex, -1];
        SetIndex[in, lineIndex];
	SELECT in.get[in] FROM
	  CR => EXIT;
	  ControlZ => GO TO skipTrailer;
	  ENDCASE;
        firstPrinted _ lineIndex;
	REPEAT
	  skipTrailer =>
	    BEGIN
	    lastPrinted _ firstPrinted _ lineIndex;
	    again _ TRUE;
	    END;
        ENDLOOP;
      ENDLOOP;
    PCr[];
    SetIndex[in, firstPrinted];
    DO
      SELECT (ch _ in.get[in]) FROM
	CR, ControlZ => EXIT;
	ENDCASE => PChar[ch];
      IF GetIndex[in] = lastPrinted THEN EXIT;
      ENDLOOP;
    EXITS
      bad =>
	BEGIN
	RESOut.Complain["Bad File Name"L];
	ERROR cancelAction;
	END;
    END;

  PrintTextLine: PROCEDURE [source: STRING, i: CARDINAL] =
    BEGIN  OPEN StreamDefs, IODefs;
    in: StreamHandle;
    start, lineIndex, mark: StreamIndex;
    char: CHARACTER;
    n: [1..100];
    in _ NewByteStream[source, Read ! SegmentDefs.FileNameError =>
	GO TO bad];
    start _ lineIndex _ mark _ NormalizeIndex[[page:0, byte:i]];
    FOR n IN [1..40] UNTIL lineIndex = [0, 0]
      DO
      lineIndex _ ModifyIndex[lineIndex, -1];
      SetIndex[in, lineIndex];
      IF in.get[in] = CR THEN EXIT;
      start _ lineIndex;
      ENDLOOP;
    firstPrinted _ lastPrinted _ start;
    SetIndex[in, start];
    FOR n IN [1..80] WHILE ~in.endof[in]
      DO
      IF GetIndex[in] = mark THEN PString["<>"L];
      lastPrinted _ GetIndex[in];
      SELECT (char _ in.get[in]) FROM
	CR, ControlZ => EXIT;
	ENDCASE => PChar[char];
      ENDLOOP;
    in.destroy[in];
    EXITS
      bad =>
	BEGIN
	RESOut.Complain["Bad File Name"L];
	ERROR cancelAction;
	END;
    END;

  CopyUserString: PRIVATE PROCEDURE [us: STRING] RETURNS [s: STRING] =
    BEGIN
    sb: StringBody;
    IF us = NIL THEN GO TO bad;
    ShortCopyREAD[to: @sb, from: us, nwords: SIZE[StringBody]];
    IF sb.length > 40 THEN GO TO bad;
    s _ Storage.String[sb.length];
    ShortCopyREAD[to: @s.text, from: @us.text, nwords: (sb.length+1)/2];
    s.length _ sb.length;
    EXITS
      bad =>
	BEGIN
	RESOut.Complain["Bad String"L];
	ERROR cancelAction;
	END;
    END;

  PutCurrentStmt: PUBLIC PROCEDURE =
    BEGIN 
    IF statement = NIL THEN 
      BEGIN
      RESOut.Complain["Base of Statement unknown"L];
      ERROR cancelAction;
      END;
    PCr[];
    PString["Current stmt tree = "L];
    PUnsigned[ShortREAD[statement+StatementrecentStmtOffset]]; 
    END;

  PutCurrentExpr: PUBLIC PROCEDURE =
    BEGIN 
    IF expression = NIL THEN 
      BEGIN
      RESOut.Complain["Base of Expression unknown"L];
      ERROR cancelAction;
      END;
    PCr[];
    PString["Current expr tree = "L];
    PUnsigned[ShortREAD[expression+ExpressionrecentExpOffset]]; 
    END;

  CopyGlobalData: PROCEDURE =
    BEGIN
    info: CodeDefs.CCInfoType _ generating;
    IF final # NIL THEN info _ ShortREAD[final+FinalccInfoOffset];
    CGenDebugDefs.ccInfo _ IF info IN CodeDefs.CCInfoType THEN info
      ELSE generating;
    IF constructor # NIL THEN
      BEGIN
      ShortCopyREAD[to: @CGenDebugDefs.cd,
        from: constructor+ConstructorcdOffset,
        nwords: SIZE[CodeDefs.ConsDestination]];
      UpdateConstDest[];
      END;
    END;

  LookupTheFrames: UserInput.PeriodicProcType =
    BEGIN
    periodic _ UserInput.CancelPeriodicNotify[periodic];
    Process.Detach[FORK LookForFrames[]];
    END;

  periodic: UserInput.PeriodicNotifyHandle _
    UserInput.CreatePeriodicNotify[LookupTheFrames, DebugUsefulDefs.window, 1];


  Notify: Event.Notifier =
    BEGIN
    SELECT why FROM
      newSession => IF periodic = NIL THEN
	periodic _ UserInput.CreatePeriodicNotify[LookupTheFrames, DebugUsefulDefs.window, 1];
      resumeSession => CopyGlobalData[];
      ENDCASE;
    SELECT why FROM
      newSession, resumeSession => 
	BEGIN
	firstPrinted _ lastPrinted _ [0,0];
	IF sourceName # NIL THEN Storage.FreeString[sourceName];
	sourceName _ NIL;
	END;
      ENDCASE;
    END;

  notifierItem: Event.Item _ [
    eventMask: Event.Masks[newSession] + Event.Masks[resumeSession], 
    eventProc: Notify];

  Event.AddNotifier[@notifierItem];


  END.