  (*$p**************************************************************************)
  (*                                                                           *)
  (*                            File: DBG.PAS.TEXT                             *)
  (*                                                                           *)
  (*              (C) Copyright 1983, 1984 Apple Computer, Inc.                *)
  (*                                                                           *)
  (*                                                                           *)
  (*                                                                5-Oct-81   *)
  (*                                                                           *)
  (*  5-09-83 Added DumpStmts and other changes to provide experimental output *)
  (*****************************************************************************)
  {[j=0/0/80!,@=11,i=1]}

  {$S DEBUG }

  PROCEDURE DumpSyms(ProcBase: PBoolean; NameTree: pN; StmtP: pStmt; NodeP: pN);
    FORWARD;

  PROCEDURE DbgOut(a: Integer);

    BEGIN {DbgOut}
      IF DebugOpen THEN
        BEGIN
        IF DbgIdx <= 511 THEN
          BEGIN
          DbgBuf[DbgIdx] := Chr(a);
          DbgIdx := DbgIdx + 1;
          END
        ELSE
          BEGIN
          IF BlockWrite(DebugFile, DbgBuf, 1, DbgBlkNum) <> 1 THEN Error(420);
          DbgBuf[0] := Chr(a);
          DbgIdx := 1;
          DbgBlkNum := DbgBlkNum + 1;
          END;
        END;
    END; {DbgOut}

  PROCEDURE DbgOut2(a: Integer);

    VAR
      c: PACKED ARRAY [0..1] OF Char;

    BEGIN {DbgOut2}
      MoveLeft(a, c, 2);
      IF FlipBytes THEN
        BEGIN
        DbgOut(Ord(c[1])); DbgOut(Ord(c[0]));
        END
      ELSE
        BEGIN
        DbgOut(Ord(c[0])); DbgOut(Ord(c[1]));
        END;
    END; {DbgOut2}

  PROCEDURE DbgOutN(l: LongInt; N: Integer);

    CONST
      BytesInParam = 4;

    VAR
      j, i: Integer;
      a: PACKED ARRAY [1..BytesInParam] OF Char;
      c: Char;

     BEGIN {DbgOutN}
      MoveLeft(l, a, BytesInParam);
      IF FlipBytes THEN
        FOR i := 1 TO BytesInParam DIV 2 DO
          BEGIN
          j := i * 2; c := a[j - 1]; a[j - 1] := a[j]; a[j] := c;
          END;
      IF N > BytesInParam THEN
        BEGIN
        FOR i := BytesInParam + 1 TO N DO DbgOut(0);
        N := BytesInParam;
        END;
      FOR i := BytesInParam + 1 - N TO BytesInParam DO DbgOut(Ord(a[i]));
    END; {DbgOutN}

  PROCEDURE DumpFatherPointer(FatherP, SonP: pN);

    VAR
      i: Integer;

    BEGIN {DumpFatherPointer}
      IF FatherP <> NIL THEN
        WITH FatherP^ DO
          IF (Class = PROC) OR (Class = FUNC) THEN
            BEGIN
            DbgOut($C4);
            DbgOutN(1 + 3 + 8 + 8 + 8 + 4, 3);
            FOR i := 1 TO 8 DO DbgOut(Ord(SonP^.Name[i]));
            FOR i := 1 TO 8 DO DbgOut(Ord(SegName[i]));
            FOR i := 1 TO 8 DO DbgOut(Ord(Name[i]));
            DbgOutN(Ord(FatherP), 4);
            END;
    END; {DumpFatherPointer}

  PROCEDURE DumpSyms{ProcBase: pBoolean; NameTree: PN; StmtP: PStmt; NodeP: PN};

    CONST
      PtrBytes = 4;
      HeapBufSize = 32767;

    TYPE
      HeapBuf = PACKED ARRAY [0..HeapBufSize] OF Char;

    VAR
      HoleBase, {first undumped location}
      HoleTop, {location after last undumped location, HoleTop-HoleBase is size
                of hole}
      HeapBase, HeapTop, UsesSize, HeapSize, HeaderSize, Max0, Min0,
      Max1: LongInt;
      HeapP: ^HeapBuf;
      i: Integer;
      lLev: DispRange;
      UsesList: pN;
      GlobalStuff, Marker: Boolean;

    PROCEDURE MarkTypes(nP: pN);

      PROCEDURE Mark(tP: pT);

        BEGIN {Mark}
          IF tP <> NIL THEN
            WITH tP^ DO
              BEGIN
              IF Marker THEN
                BEGIN
                IF Max0 < Ord(tP) THEN Max0 := Ord(tP);
                IF Min0 > Ord(tP) THEN Min0 := Ord(tP);
                END
              ELSE
                BEGIN
                IF Max1 < Ord(tP) THEN Max1 := Ord(tP);
                END;
              Marked := Marker;
              CASE Form OF
                SCALAR:    ;
                SUBRANGE:  Mark(RangeOf);
                POINTERS: { PointerTo will be picked up later } ;
                SETS:      Mark(SetOf);
                ARRAYS:    BEGIN
                           Mark(ArrayOf); Mark(IndexedBy);
                           END;
                RECORDS:   Mark(VarPart);
                TAGFIELD:  Mark(Variants);
                VARIANT:   BEGIN
                           Mark(NextVar); Mark(SubVar);
                           END;
                FILES:     Mark(FileOf)
              END; {case}
              END; {with}
        END; {Mark}

      BEGIN {MarkTypes}
        IF nP <> NIL THEN
          WITH np^ DO
            BEGIN
            MarkTypes(Llink);
            Mark(IdType);
            MarkTypes(Rlink);
            END;
      END; {MarkTypes}

    PROCEDURE WriteNode(PNode: pN; Indent: Integer; DoIndent: Boolean);

      VAR
        i: Integer;

      BEGIN {WriteNode}
        IF DoIndent THEN Write(Debugging, ' ': Indent);
        Write(Debugging, Ord(PNode): 9);
        IF PNode = NIL THEN
          BEGIN
          IF DoIndent = False THEN WriteLn(Debugging);
          END
        ELSE
          WITH PNode^ DO
            BEGIN
            CASE Node OF
              IDENTNODE: BEGIN
                         Write(Debugging, ' Id: ', Name: 9, Ord(Llink): 9,
                               Ord(Rlink): 9, Ord(Next): 9, ' type=',
                               Ord(IdType): 9);
                         CASE Class OF                                         {!}{[@=8]}
                           CONSTS: Write(Debugging, ' Const ', ValueOf.Ivalu: 6);
                           TYPES:  Write(Debugging, ' Type  ');
                           VARS:   Write(Debugging, ' Var   ', Ord(Vkind): 6,
                                         Vlev: 6, Voff: 6);
                           FIELD:  Write(Debugging, ' Field ', FOff: 6,
                                         Ord(PckdField): 2, BitOff: 3);
                           PROC, FUNC:
                                   IF Class = PROC THEN
                                     Write(Debugging, ' Proc  ')
                                   ELSE
                                     Write(Debugging, ' Func  ');
                           UNITS:  Write(Debugging, ' Unit  ', Ulev: 6, ULc: 6)
                         END; {case}
                         WriteLn(Debugging);
                         END;
              REGISTER:  BEGIN
                         WriteLn(Debugging, ' Register: ', Reg: 4, ' load=', Load: 3,
                                ' size=', LoadSize: 6, Ord(LoadExpr): 9);
                         IF LoadExpr <> NIL THEN
                           WriteNode(LoadExpr, Indent, True);
                         END;
              UNNODE:    BEGIN
                         WriteLn(Debugging, ' Una: op=', UnOp: 3, ' subop=',
                                 UnSubOp: 6, Ord(UnArg): 9);
                         WriteNode(UnArg, Indent, True);
                         END;
              BINNODE:   BEGIN
                         WriteLn(Debugging, ' Bin: op=', BinOp: 3, ' subop=',
                                 BinSubOp: 6, Ord(LeftArg): 9, Ord(RightArg): 9);
                         IF BinOp <> 46 {RangeCheck} THEN
                           BEGIN
                           Write(Debugging, ' ': Indent + 2, 'Leftarg: ');
                           WriteNode(LeftArg, Indent + 2, False);
                           END;
                         Write(Debugging, ' ': Indent + 2, 'Rightarg: ');
                         WriteNode(RightArg, Indent + 2, False);
                         END;
              TRINODE:   BEGIN
                         WriteLn(Debugging, ' Tri: op=', TriOp: 3, Ord(Tri1): 9,
                                 Ord(Tri2): 9, Ord(TriSuper): 9, Ord(TripN): 9);
                         Write(Debugging, ' ': Indent + 2, 'Tri1: ');
                         WriteNode(Tri1, Indent + 2, False);
                         Write(Debugging, ' ': Indent + 2, 'Tri2: ');
                         WriteNode(Tri2, Indent + 2, False);
                         IF TriOp <> 16 {index} THEN
                           BEGIN
                           Write(Debugging, ' ': Indent + 2, 'Tripn: ');
                           WriteNode(TripN, Indent + 2, True);
                           END;
                         END;
              CSTNODE:   WriteLn(Debugging, ' Cst: ', Ord(CstType): 9,
                                 CstValu.Ivalu: 6);
              CSE:       BEGIN
                         WriteLn(Debugging, ' CSE: ',Ord(CSEpN):9, CSEindex:6);
                         writenode(CSEpN, Indent+2, false);
                         END;
              ASGNNODE:  BEGIN
                         WriteLn(Debugging, ' Asgnnode: op=', AsgnOp: 3, Ord(AsgnVar): 9,
                                 Ord(AsgnExpr): 9, Ord(AsgnpN): 9);
                         Write(Debugging, ' ': Indent + 2, 'AsgnVar: ');
                         WriteNode(AsgnVar, Indent + 2, False);
                         Write(Debugging, ' ': Indent + 2, 'AsgnExpr: ');
                         WriteNode(AsgnExpr, Indent + 2, False);
                         Write(Debugging, ' ': Indent + 2, 'AsgnpN: ');
                         WriteNode(AsgnpN, Indent + 2, True);
                         END;
            END; {case}
            END; {with}
      END; {WriteNode}

    PROCEDURE WriteType(FTypeP: pT);

      BEGIN {WriteType}
        Write(Debugging, 'Type - ', Ord(FTypeP): 6);
        WITH FTypeP^ DO
          BEGIN
          Write(Debugging, Ord(Marked): 2, Bytes: 6, Bits: 2, Ord(FType): 2);
          CASE Form OF
            SCALAR:    BEGIN
                       Write(Debugging, ' Scalar');
                       CASE ScalKind OF
                         STANDARD:  Write(Debugging, ' Standard');
                         DECLARED:  Write(Debugging, ' Declared', Ord(MaxConst):
                                          6);
                       END;
                       END;
            SUBRANGE:  Write(Debugging, ' Subrange', Ord(RangeOf): 6, Min: 6, Max:
                             6);
            POINTERS:  Write(Debugging, ' Pointer', Ord(PointerTo): 6);
            SETS:      Write(Debugging, ' Set', Ord(SetOf): 6);
            ARRAYS:    Write(Debugging, ' Array', Ord(IndexedBy): 6, Ord(ArrayOf):
                             6, Ord(PckdArr): 2, Ord(BitPacked): 2,
                             Ord(BitsPerEl): 2);
            RECORDS:   Write(Debugging, ' Record', Ord(PckdRec): 2, Ord(Fields):
                             6, Ord(FstField): 6, Ord(VarPart): 6);
            TAGFIELD:  Write(Debugging, ' Tag', Ord(TagName): 6, Ord(Variants):
                             6);
            VARIANT:   Write(Debugging, ' Variant', Ord(VarFldLst): 6,
                             Ord(NextVar): 6, Ord(SubVar): 6, Ord(VarValus): 6);
            FILES:     Write(Debugging, ' File', Ord(PckdFile): 2, Ord(FileOf):
                             6);
            STRINGS:   Write(Debugging, ' String', StringLen: 6);
            SCONST:    Write(Debugging, ' StringConst', StringLen: 6);
          END; {case}
          END; {with}
        WriteLn(Debugging);
      END; {WriteType}

    PROCEDURE DumpNodes(nP: pN);

      PROCEDURE DumpTypes(tP: pT);

        BEGIN {DumpTypes}
          IF tP <> NIL THEN
            WITH tP^ DO
              IF Marked THEN
                BEGIN
                Marked := False;
                WriteType(tP);
                CASE Form OF                                                   {!}{[@=12]}
                  SCALAR:     ;
                  SUBRANGE:   DumpTypes(RangeOf);
                  POINTERS:   DumpTypes(PointerTo);
                  SETS:       DumpTypes(SetOf);
                  ARRAYS:     BEGIN
                              DumpTypes(IndexedBy);
                              DumpTypes(ArrayOf);
                              END;
                  RECORDS:    BEGIN
                              DumpTypes(VarPart);
                              DumpNodes(Fields);
                              END;
                  TAGFIELD:   DumpTypes(Variants);
                  VARIANT:    BEGIN
                              DumpTypes(NextVar);
                              DumpTypes(SubVar);
                              END;
                  FILES:      DumpTypes(FileOf);
                  STRINGS:    ;
                  SCONST:
                END; {case}
                END; {if}
        END; {DumpTypes}

      BEGIN {DumpNodes}
        IF np <> NIL THEN
          WITH np^ DO
            BEGIN
            IF Node = IDENTNODE THEN DumpNodes(Rlink);
            WriteNode(np, 0, False);
            DumpTypes(IdType);
            IF Node = IDENTNODE THEN DumpNodes(Llink);
            END; {with}
      END; {DumpNodes}

    PROCEDURE DumpStmts(fStmt: pStmt; Indent: Integer);

      TYPE
        String20 = String[20];

      VAR
        lIntP: pIntList;
        i: Integer;

      PROCEDURE NodeDescr(fNode: pN; Name: String20);

        BEGIN {NodeDescr}
          Write(Debugging, ' ': Indent + 4, Name);
          WriteNode(fNode, Indent + 4 + Length(Name), False);
        END; {NodeDescr}

      BEGIN {Dumpstmts}
        WHILE fStmt <> NIL DO
          WITH fStmt^ DO
            BEGIN
            Write(Debugging, ' ': Indent, StmtNumb: 3);
            CASE StmtOp OF
              BEGINST:    BEGIN
                          WriteLn(Debugging, ' BEGIN');
                          DumpStmts(SubSt, Indent + 2);
                          END;
              METHODCALL, ASSIGNST:
                          BEGIN
                          WriteLn(Debugging, ' ASSIGN ', AssOp: 4, ' flipbl=',
                                  Flippable, AssSubOp: 4);
                          NodeDescr(AssVar, 'assvar');
                          NodeDescr(AssExpr, 'assexpr');
                          END;
              FORTOST, FORDOWNST:
                          BEGIN
                          WriteLn(Debugging, ' FOR', ForSize: 4);
                          NodeDescr(ForVar, 'forvar');
                          NodeDescr(ForInit, 'forinit');
                          NodeDescr(ForLimit, 'forlimit');
                          DumpStmts(ForSt, Indent + 2);
                          END;
              IFST:       BEGIN
                          WriteLn(Debugging, ' IF');
                          NodeDescr(IfExpr, 'ifexpr');
                          Write(Debugging, ' ': Indent + 4, 'THEN');
                          DumpStmts(ThenSt, Indent + 2);
                          IF ElseSt <> NIL THEN
                            BEGIN
                            Write(Debugging, ' ': Indent + 4, 'ELSE');
                            DumpStmts(ElseSt, Indent + 2);
                            END;
                          END;
              WITHST:     BEGIN
                          WriteLn(Debugging, ' WITH');
                          NodeDescr(WithVar, 'withvar');
                          DumpStmts(WithBody, Indent + 2);
                          END;
              REPST, WHILEST:
                          BEGIN
                          WriteLn(Debugging, ' REP/WHILE');
                          NodeDescr(CondExpr, 'condexpr');
                          DumpStmts(LoopStmt, Indent + 2);
                          END;
              CALLST:     BEGIN
                          WriteLn(Debugging, ' CALL');
                          NodeDescr(ProcpN, 'procpn');
                          NodeDescr(pArgList, 'parglist');
                          END;
              GOTOST:     WriteLn(Debugging, ' GOTO', Ord(GotoLab): 9, ' lev=',
                                  LabLev: 8);
              CASEST:     BEGIN
                          WriteLn(Debugging, ' CASE');
                          NodeDescr(CaseExpr, 'caseexpr');
                          DumpStmts(CStmtList, Indent + 2);
                          Write(Debugging, ' ': Indent + 4, 'OTHERWISE');
                          DumpStmts(OtherStmt, Indent + 2);
                          END;
              CSTMTST:    BEGIN
                          Write(Debugging, ' CSTMTST, casevals = ');
                          i := 6;
                          lIntP := CaseVals;
                          WHILE lIntP <> NIL DO
                            BEGIN
                            i := i + 1;
                            IF i > 10 THEN
                              BEGIN
                              WriteLn; i := 1
                              END;
                            Write(Debugging, lIntP^.IntVal: 6);
                            lIntP := lIntP^.NextInt;
                            END;
                          WriteLn(Debugging);
                          DumpStmts(ThisCase, Indent + 2);
                          END;
              LABEDST:    BEGIN
                          WriteLn(Debugging, ' LABEL', Ord(StLab): 9);
                          DumpStmts(LabStmt, Indent + 2);
                          END;
              TEMPST:     WriteLn(Debugging, ' TEMPSTMT', TempCSEregs.iMask: 9,
                                  TempLevel: 6);
              NULLST:     Writeln(Debugging,' NULLST');
            END; {case}
            fStmt := NextStmt;
            END; {with}
      END; {Dumpstmts}

    FUNCTION Min(i, j: LongInt): LongInt;

      BEGIN {Min}
        IF i < j THEN
          Min := i
        ELSE
          Min := j
      END; {Min}

    FUNCTION Max(i, j: LongInt): LongInt;

      BEGIN {Max}
        IF i > j THEN
          Max := i
        ELSE
          Max := j
      END; {Max}

    BEGIN {DumpSyms}
      GlobalStuff := (Top = 1) AND (NodeP <> NIL);

      HeaderSize := 1 + 3 + 8 + 8 + 4 + 4 + 4 + 4 + 4;

      IF DebugDebug THEN
        BEGIN
        IF NodeP <> NIL THEN
          WriteLn(Debugging, 'Symbols for ''', NodeP^.Name, ''' segment ''',
                  SegName, '''')
        ELSE
          WriteLn(Debugging, 'Symbols for level ', Top: 1);
        Max0 := 0; Min0 := Ord(ProcBase); Max1 := 0;
        Marker := True;
        MarkTypes(NameTree);
        Marker := False;
        IF Top > 0 THEN
          FOR lLev := Top - 1 DOWNTO 0 DO MarkTypes(Display[lLev].NameTree);
        DumpNodes(NameTree);
        DumpStmts(StmtP, 0);
        END;

      Mark(HeapP);
      HeapTop := Ord(HeapP);
      HeapBase := Ord(ProcBase);
      IF DebugDebug THEN
        WriteLn(Debugging, 'HeapBase ', HeapBase: 6, ', NameTree ', Ord(NameTree),
                ', StmtP ', Ord(StmtP): 6, ', NodeP ', Ord(NodeP): 6);
      IF Ord(NameTree) > 0 THEN HeapBase := Min(HeapBase, Ord(NameTree));
      IF Ord(StmtP) > 0 THEN HeapBase := Min(HeapBase, Ord(StmtP));
      IF Ord(NodeP) > 0 THEN HeapBase := Min(HeapBase, Ord(NodeP));

      UsesSize := 0;
      IF GlobalStuff THEN
        BEGIN { compute where the hole (if any) lives }
        UsesList := UnitList;
        IF UsesList <> NIL THEN
          BEGIN
          HoleBase := Ord(UsesList);
          HoleTop := Ord(UsesList^.Utop);
          WHILE UsesList <> NIL DO
            BEGIN
            IF UsesList^.Ulev <> - 1 THEN
              BEGIN
              UsesSize := UsesSize + 1;
              HoleBase := Min(HoleBase, Ord(UsesList));
              HoleTop := Max(HoleTop, Ord(UsesList^.Utop));
              END;
            UsesList := UsesList^.Next;
            END;
          END;
        IF UsesSize > 0 THEN HeaderSize := HeaderSize + 4 + 4;
        END;
      IF UsesSize = 0 THEN
        BEGIN { no hole so make sure HoleBase = HoleTop }
        HoleBase := HeapBase;
        HoleTop := HeapBase;
        END;
      HeapSize := (HeapTop - HeapBase) - (HoleTop - HoleBase);
      UsesSize := UsesSize * (4 + 4 + 8);

      IF DebugDebug THEN
        WriteLn(Debugging, 'level ', Top: 2, ', RecSize ', HeaderSize +
                UsesSize + HeapSize: 6, ', HeapBase ', HeapBase: 6,
                ', NameTree ', Ord(NameTree): 6, ', HeapTop ', HeapTop: 6);

      DbgOut($C0);
      DbgOutN(HeaderSize + UsesSize + HeapSize, 3);

      IF NodeP <> NIL THEN
        FOR i := 1 TO 8 DO DbgOut(Ord(NodeP^.Name[i]))
      ELSE
        FOR i := 1 TO 8 DO DbgOut(Ord(' '));
      FOR i := 1 TO 8 DO DbgOut(Ord(SegName[i]));

      DbgOutN(HeapBase, 4);
      DbgOutN(Ord(NameTree), 4);
      DbgOutN(Ord(StmtP), 4);
      DbgOutN(Ord(NodeP), 4);

      DbgOutN(UsesSize, 4);
      IF UsesSize > 0 THEN
        BEGIN
        DbgOutN(HoleBase, 4);
        DbgOutN(HoleTop, 4);
        UsesList := UnitList;
        WHILE UsesList <> NIL DO
          BEGIN
          IF UsesList^.Ulev <> - 1 THEN
            BEGIN
            DbgOutN(Ord(UsesList), 4);
            DbgOutN(Ord(UsesList^.Utop), 4);
            FOR i := 1 TO 8 DO DbgOut(Ord(UsesList^.Name[i]));
            END;
          UsesList := UsesList^.Next;
          END;
        END;

      MoveLeft(HeapBase, HeapP, PtrBytes);
      { Dump from HeapBase to HoleBase-1 }
      FOR i := 0 TO (HoleBase - HeapBase) - 1 DO DbgOut(Ord(HeapP^[i]));

      MoveLeft(HoleTop, HeapP, PtrBytes);
      { Dump from HoleTop to ProcBase }
      FOR i := 0 TO (HeapTop - HoleTop) - 1 DO DbgOut(Ord(HeapP^[i]));

      IF DebugDebug THEN
        WriteLn(Debugging, 'DumpSyms, dumped ', HeapSize: 1, ' bytes');

      IF Top > 0 THEN DumpFatherPointer(Display[Top - 1].RootLink, NodeP);
    END; {DumpSyms}

