(****************************************
*                                       *
*     MODULA-2 Multi-Pass Compiler      *
*     ****************************      *
*                                       *
*       VAX/VMS Implementation          *
*                                       *
*                                       *
*     MVCDebug:                         *
*                                       *
*     Debugger/Linker interface         *
*     in Pass 4                         *
*                                       * 
*     Version 3.1 of  1-FEB-1983        *
*                                       *
*                                       *
*     D-2000 HAMBURG 13                 *
*                                       *
****************************************)

(****************************************
* Updates:                              *
****************************************)

IMPLEMENTATION MODULE MVCDebug; (* E. Kisicki *)

  IMPORT SYSTEM, MVCompiler, MVCPublic, MVCIO4, MVCLi4,
         FileSystem, LinkerDefinitions, RMS, VMS, Storage;

  FROM SYSTEM IMPORT BYTE, ADR, ADDRESS;
  FROM MVCompiler IMPORT Spellix, spelltab, Idclass, Idptr, Stptr, Structform,
                         Varkind, Kindvar, mainmodp, Keyarr, Stset,
                         addrptr, wordptr, dfloatptr;
  FROM MVCPublic IMPORT modFile, source;
  FROM MVCIO4 IMPORT printlc, line, debug, PutByte, PutShortWord,
                     PutWord, PutRecord, CompError, Assert, Error;
  FROM MVCLi4 IMPORT PutControlledString, SearchSpellTable, GetLine;
  FROM FileSystem IMPORT File, Fab;
  FROM LinkerDefinitions IMPORT OBJ$C_, OBJ$C_TIR_, OBJ$C_MAXRECSIZ;
  FROM RMS IMPORT FABptr, XABRDT, XABFHC, InitXabRdt, InitXabFhc;
  FROM VMS IMPORT SYS$DISPLAY;
  FROM Storage IMPORT ALLOCATE;

  CONST
    maximalSymbolSize = 31;
    maximalCodeSize  = 128;
    variablePsect    = 0;
    codePsect        = 2;

  TYPE
    SymbolSize = [0..maximalSymbolSize];
    SymbolName = ARRAY [0..maximalSymbolSize-1] OF CHAR;

  VAR
    nameLength: CARDINAL;

  CONST
    maximalDSTRecordSize = maximalCodeSize-1;
    maximalDSTEntrySize = 50;
    lengthOfType = 7;
    lengthOfValue = 5;
    lengthOfAddress = 5;
    lengthOfReference = 4;
    lengthOfDescriptor = 32;

    DSC$K_DTYPE_Z  = 0;
    DSC$K_DTYPE_B  = 6;
    DSC$K_DTYPE_W  = 7;
    DSC$K_DTYPE_L  = 8;
    DSC$K_DTYPE_Q  = 9;
    DSC$K_DTYPE_F  = 10;
    DSC$K_DTYPE_D  = 11;
    DSC$K_DTYPE_T  = 14;
    DSC$K_DTYPE_ZI = 22;
    DSC$K_DTYPE_O  = 26;
    DSC$K_DTYPE_G  = 27;
    DSC$K_DTYPE_H  = 28;

    DSC$K_CLASS_NCA = 10;

    DST$K_DELTA_PC_W = 1;

    DST$K_INCR_LINUM = 2;
    DST$K_INCR_LINUM_W = 3;

    DST$K_TERM = 14;
    DST$K_TERM_W = 15;

    DST$K_SRC_DECLFILE   = 1;
    DST$K_SRC_SETFILE    = 2;
    DST$K_SRC_DEFLINES_W = 10;

    DST$K_TS_ATOM = 1;
    DST$K_TS_DSC = 2;
    DST$K_TS_IND = 3;
    DST$K_TS_TPTR = 4;
    DST$K_TS_PTR = 5;
    DST$K_TS_PIC = 6;
    DST$K_TS_ARRAY = 7;
    DST$K_TS_SET = 8;
    DST$K_TS_SUBRANGE = 9;
    DST$K_TS_NOV_LENG = 14;

    DST$K_VALKIND_LITERAL = 0;
    DST$K_VALKIND_ADDR = 1;
    DST$K_VALKIND_DESC = 2;
    DST$K_VALKIND_REG = 3;

    DST$K_VFLAGS_NOVAL = 128;
    DST$K_VFLAGS_DSC = 250;
    DST$K_VFLAGS_BITOFFS = 255;

    DST$K_SOURCE = 155;
    DST$K_VARVAL = 157;
    DST$K_GLOBNXT = 160;
    DST$K_SEPTYP = 163;
    DST$K_ENUMELT = 164;
    DST$K_ENUMBEG = 165;
    DST$K_ENUMEND = 166;
    DST$K_VARBEG = 167;
    DST$K_VAREND = 168;
    DST$K_RECBEG = 171;
    DST$K_RECEND = 172;
    DST$K_VALSPEC = 174;
    DST$K_TYPSPEC = 175;
    DST$K_LINE_NUM = 185;
    DST$K_MODBEG = 188;
    DST$K_MODEND = 189;
    DST$K_RTNBEG = 190;
    DST$K_RTNEND = 191;

  TYPE
    DSTRecordSize = [0..maximalDSTRecordSize];
    DSTRecord = [0..maximalDSTRecordSize-1];

  VAR
    DST: ARRAY DSTRecord OF BYTE;
    grecc, lDSTl, lDSTc, gDSTc: DSTRecordSize;
    oldline: CARDINAL;


  PROCEDURE PutName(fstring: ARRAY OF CHAR);

    VAR
      l: SymbolSize;

  BEGIN
    l := LEN(fstring);
    IF l > 0 THEN
      IF l > maximalSymbolSize THEN
        l := maximalSymbolSize
      END;
      PutByte(l);
      PutControlledString(fstring,l,TRUE)
    ELSE Error(404)
    END;
    nameLength := CARDINAL(l)
  END PutName;

  PROCEDURE StartDBG;

  BEGIN
    IF grecc = 0 THEN
      PutByte(OBJ$C_DBG);
      INC (grecc);
    END;
  END StartDBG;

  PROCEDURE PutDBG;

  BEGIN
    IF grecc + maximalDSTRecordSize > OBJ$C_MAXRECSIZ THEN
      PutRecord;
      grecc := 0;
    END;
  END PutDBG;

  PROCEDURE PutDST (next: BOOLEAN);

    VAR
      k: DSTRecordSize;

  BEGIN
    k := 0;
    IF lDSTc > 0 THEN
      StartDBG;
      PutByte(-INTEGER(lDSTc));
      WHILE k < lDSTc DO
        PutByte(DST[k]);
        INC(k);
      END;
      INC(grecc,lDSTc+1);
      lDSTc := 0;
      lDSTl := 0;
    END;
    PutDBG;
    IF next THEN
      StartDBG;
    END;
  END PutDST;

  PROCEDURE StartDST;

  BEGIN
    lDSTl := lDSTc;
    DST[lDSTc] := BYTE(0);
    INC(lDSTc);
    INC(gDSTc);
  END StartDST;

  PROCEDURE AddDST(val: CARDINAL);

  BEGIN
    INC(gDSTc,val);
    DST[lDSTl] := BYTE(CARDINAL(DST[lDSTl]) + val);
  END AddDST;

  PROCEDURE EnterDSTByte(val: BYTE);

  BEGIN
    IF lDSTc >= maximalDSTRecordSize THEN
      Error(404);
    END;
    DST[lDSTc] := val;
    INC(lDSTc);
    INC(gDSTc);
    DST[lDSTl] := BYTE(CARDINAL(DST[lDSTl]) + 1);
  END EnterDSTByte;

  PROCEDURE EnterDSTShortWord(val: CARDINAL);

    VAR
      dummy: RECORD
               CASE BOOLEAN OF
                 TRUE  : w: CARDINAL; |
                 FALSE : b: ARRAY [0..1] OF BYTE;
               END;
             END;
      k: CARDINAL;

  BEGIN
    dummy.w := val;
    FOR k := 0 TO 1 DO
      EnterDSTByte(dummy.b[k]);
    END;
  END EnterDSTShortWord;

  PROCEDURE EnterDSTWord(val: CARDINAL);

    VAR
      dummy: RECORD
               CASE BOOLEAN OF
                 TRUE  : w: CARDINAL; |
                 FALSE : b: ARRAY [0..3] OF BYTE;
               END;
             END;
      k: CARDINAL;

  BEGIN
    dummy.w := val;
    FOR k := 0 TO 3 DO
      EnterDSTByte(dummy.b[k]);
    END;
  END EnterDSTWord;

  PROCEDURE PutDebuggerInformation(fidptr: Idptr);

    VAR
      lid: Idptr;
      dflocc: CARDINAL;

    PROCEDURE PutVariable (id: Idptr);

      PROCEDURE DataType(st: Stptr): CARDINAL;

      BEGIN
        CASE st^.form OF
          ints     : RETURN DSC$K_DTYPE_L; |
          cards    : RETURN DSC$K_DTYPE_L(*U*); |
          chars    : RETURN DSC$K_DTYPE_T; |
          words    : CASE st^.size OF
                       1: RETURN DSC$K_DTYPE_B(*U*); |
                       2: RETURN DSC$K_DTYPE_W(*U*); |
                       4: RETURN DSC$K_DTYPE_L(*U*); |
                       8: RETURN DSC$K_DTYPE_L(*QU*); |
                       16: RETURN DSC$K_DTYPE_L(*OU*);
                     ELSE CompError;
                     END; |
          hides    : RETURN DSC$K_DTYPE_L; |
          reals    : CASE st^.size OF
                       4: RETURN DSC$K_DTYPE_F; |
                       8: IF st = dfloatptr THEN
                            RETURN DSC$K_DTYPE_D
                          ELSE RETURN DSC$K_DTYPE_G;
                          END; |
                       16: RETURN DSC$K_DTYPE_H;
                     ELSE CompError;
                     END; |
          proctypes: RETURN DSC$K_DTYPE_ZI;
        ELSE RETURN DSC$K_DTYPE_Z;
        END;
      END DataType;

      PROCEDURE LoadName (fname: SymbolName; add: BOOLEAN);

      BEGIN
        IF add THEN
          AddDST (LEN(fname)+1);
          PutDST (TRUE);
        END;
        PutByte(-LEN(fname)-1);
        PutName (fname);
        INC (grecc, LEN(fname)+2);
      END LoadName;

      PROCEDURE LoadAddress (id: Idptr);

      BEGIN
        WITH id^ DO
          IF klass = fields THEN
            PutByte(-5);
            PutByte(DST$K_VFLAGS_BITOFFS);
            PutWord(fldaddr*8);
            INC (grecc, 6);
          ELSE 
            IF state = absolute THEN
              PutByte(-5);
              PutByte(DST$K_VALKIND_ADDR);
              PutWord(vaddr);
              INC (grecc, 6);
            ELSIF state = global THEN
              PutByte(-1);
              PutByte(DST$K_VALKIND_ADDR);
              PutByte(TIR$C_STA_PL);
              PutByte(variablePsect);
              PutWord(vaddr+4);
              PutByte(TIR$C_STO_PIDR);
              INC (grecc, 9);
            ELSE 
              PutByte(-5);
              WITH idtyp^ DO
                IF (form = arrays) AND dyn THEN
                  PutByte(0DDH); (* <== @vaddr+4(FP)*)
                  PutWord(vaddr+4);
                ELSIF vkind = varparam THEN
                  PutByte(0DDH); (* <== @vaddr(FP) *)
                  PutWord(vaddr);
                ELSE (*vkind = valparam OR vkind = noparam*)
                  PutByte(0D9H); (* <== vaddr(FP)  *)
                  PutWord(vaddr);
                END;
              END;
              INC (grecc, 6);
            END;
          END;
        END;
      END LoadAddress;

      PROCEDURE LoadVariable (id: Idptr);

        VAR
          vname: SymbolName;

      BEGIN
        WITH id^ DO
          SearchSpellTable (name, vname);
          AddDST (lengthOfAddress+LEN(vname)+1);
          PutDST (TRUE);
          LoadAddress (id);
          LoadName (vname, FALSE);
        END;
      END LoadVariable;

      PROCEDURE SizeInBytes (fval: CARDINAL): CARDINAL;

      BEGIN
        IF fval > 0FFFFH THEN
          RETURN 4;
        ELSIF fval > 0FFH THEN
          RETURN 2;
        ELSE RETURN 1;
        END;
      END SizeInBytes;

      PROCEDURE LoadValue (fval: CARDINAL);

      BEGIN
        PutByte(-5);
        PutByte(DST$K_VALKIND_LITERAL);
        PutWord(fval);
        INC (grecc, 6);
      END LoadValue;

      PROCEDURE LoadDescriptor (st, est, ist: Stptr);

      BEGIN
        PutByte(-lengthOfDescriptor);

        PutShortWord(est^.size);
        PutByte(DataType(est));
        PutByte(DSC$K_CLASS_NCA);
        PutWord(0);
        PutByte(0);
        PutByte(0);
        PutByte(0);
        PutByte(1);
        PutWord(st^.size);

        PutWord(0);
        PutWord(est^.size);

        IF st^.dyn THEN
          PutWord(0);
          PutWord(0FFFFH);
        ELSE
          PutWord(ist^.min);
          PutWord(ist^.max);
        END;

        INC (grecc, lengthOfDescriptor);
      END LoadDescriptor;

      PROCEDURE LoadReference (fval: CARDINAL);

      BEGIN
        PutByte(TIR$C_STA_UB);
        PutByte(1 (* <== location one for DST-start *) );
        PutByte(TIR$C_CTL_STKDL);
        INC (grecc, 3);
        CASE SizeInBytes(fval) OF
          4: PutByte(TIR$C_STA_LW);
            PutWord(fval);
            INC (grecc, 5); |
          2: PutByte(TIR$C_STA_UW);
            PutShortWord(fval);
            INC (grecc, 3); |
          1: PutByte(TIR$C_STA_UB);
            PutByte(fval);
            INC (grecc, 2);
        END;
      END LoadReference;

      PROCEDURE LoadType (st: Stptr);

      BEGIN
        PutByte(-3);
        PutShortWord(5);
        PutByte(DST$K_TS_IND);
        INC (grecc, 4);
        IF st^.stidp = NIL THEN
          PutWord(0);
          INC (grecc, 4);
        ELSE 
          LoadReference (st^.stidp^.dstaddr);
          PutByte(TIR$C_OPR_ADD);
          PutByte(TIR$C_STO_LW);
          INC (grecc, 2);
        END;
      END LoadType;

      PROCEDURE Inspect (st: Stptr);

        VAR
          lidptr: Idptr;
          lstptr: Stptr;
          ename: SymbolName;
          c: CARDINAL;

      BEGIN
        IF st <> NIL THEN
          WITH st^ DO
            IF stidp = NIL THEN
              NEW(stidp,types);
              WITH stidp^ DO
                name := 0;
                idtyp := st;
                link := NIL;
                globmodp := NIL;
                klass := types;
                dstaddr := 0;
              END;
            END;
            IF stidp^.dstaddr = 0 THEN
              stidp^.dstaddr := 0FFFFFFFFH;
              CASE form OF
                ints, cards, chars, words, reals, proctypes, hides : 
                  PutDST(TRUE);
                  stidp^.dstaddr := gDSTc;
                  StartDST;
                  EnterDSTByte (DST$K_TYPSPEC);
                  EnterDSTByte (0);
                  EnterDSTShortWord (2);
                  EnterDSTByte (DST$K_TS_ATOM);
                  EnterDSTByte (DataType(st)); |
                opens : 
                  Inspect (openstruc);
                  stidp^.dstaddr := openstruc^.stidp^.dstaddr; |
                arrays : 
                  Inspect (elp);
                  IF stidp^.dstaddr = 0FFFFFFFFH THEN
                    (* nothing happend in between*)
                    Inspect (ixp);
                    PutDST (TRUE);
                    stidp^.dstaddr := gDSTc;
                    StartDST;
                    EnterDSTByte (DST$K_TYPSPEC);
                    EnterDSTByte (0);
                    EnterDSTShortWord (8+2*lengthOfType+lengthOfDescriptor);
                    EnterDSTByte (DST$K_TS_ARRAY);
                    EnterDSTByte (1);
                    EnterDSTByte (3 (* <== cell- and subscript-type there *) );
                    EnterDSTByte (DST$K_VFLAGS_DSC);
                    EnterDSTWord (2*lengthOfType);
                    AddDST (2*lengthOfType+lengthOfDescriptor);
                    PutDST (TRUE);
                    LoadType (elp);
                    LoadType (ixp);
                    LoadDescriptor (st, elp, ixp);
                  END; |
                records : 
                  PutDST(TRUE);
                  stidp^.dstaddr := gDSTc;
                  StartDST;
                  EnterDSTByte (DST$K_RECBEG);
                  EnterDSTByte (DST$K_VFLAGS_NOVAL);
                  EnterDSTWord (0);
                  EnterDSTByte (0);
                  EnterDSTWord (size*8);
                  lidptr := fieldp;
                  WHILE lidptr <> NIL DO
                    WITH lidptr^ DO
                      PutDST (TRUE);
                      IF DataType (lidptr^.idtyp) = DSC$K_DTYPE_Z THEN
                        Inspect (lidptr^.idtyp);
                        PutDST (TRUE);
                        StartDST;
                        EnterDSTByte (DST$K_SEPTYP);
                        LoadVariable (lidptr);
                        PutDST (TRUE);
                        StartDST;
                        EnterDSTByte (DST$K_TYPSPEC);
                        EnterDSTByte (0);
                        AddDST (lengthOfType);
                        PutDST (TRUE);
                        LoadType (idtyp);
                      ELSE
                        StartDST;
                        EnterDSTByte (DataType(lidptr^.idtyp));
                        LoadVariable (lidptr);
                      END;
                      lidptr := link;
                    END;
                  END;
                  PutDST (TRUE);
                  StartDST;
                  EnterDSTByte (DST$K_RECEND); |
                pointers : 
                  PutDST(TRUE);
                  stidp^.dstaddr := gDSTc;
                  StartDST;
                  EnterDSTByte (DST$K_TYPSPEC);
                  EnterDSTByte (0);
                  EnterDSTShortWord (1+lengthOfType);
                  EnterDSTByte (DST$K_TS_TPTR);
                  AddDST (lengthOfType);
                  PutDST(TRUE);
                  IF (elemp^.stidp <> NIL) AND
                     (elemp^.stidp^.dstaddr = 0FFFFFFFFH) THEN
                    elemp^.stidp^.dstaddr := 0;
                    Assert (elemp^.form = arrays);
                    (* should only happen for arrays *)
                  END;
                  IF (elemp^.stidp = NIL) OR (elemp^.stidp^.dstaddr = 0) THEN
                    PutByte(TIR$C_STA_UB);
                    PutByte(dflocc);
                    DEC(dflocc);
                    PutByte(TIR$C_CTL_DFLOC);
                    PutByte(-lengthOfType);
                    FOR c := 1 TO lengthOfType DO
                      PutByte(0)
                    END;
                    INC(grecc,4+lengthOfType);
                    Inspect (elemp);
                    PutDST (TRUE);
                    PutByte(TIR$C_STA_UB);
                    PutByte(2);
                    PutByte(TIR$C_CTL_DFLOC);
                    INC(dflocc);
                    PutByte(TIR$C_STA_UB);
                    PutByte(dflocc);
                    PutByte(TIR$C_CTL_STLOC);
                    INC(grecc,6);
                    LoadType (elemp);
                    PutByte(TIR$C_STA_UB);
                    PutByte(2);
                    PutByte(TIR$C_CTL_STLOC);
                    INC(grecc,3);
                  ELSE 
                    LoadType (elemp)
                  END; |
                sets : 
                  PutDST(TRUE);
                  Inspect (basep);
                  PutDST(TRUE);
                  stidp^.dstaddr := gDSTc;
                  StartDST;
                  EnterDSTByte (DST$K_TYPSPEC);
                  EnterDSTByte (0);
                  EnterDSTShortWord (5+lengthOfType);
                  EnterDSTByte (DST$K_TS_SET);
                  EnterDSTWord (size*8);
                  AddDST (lengthOfType);
                  PutDST (TRUE);
                  LoadType (basep); |
                enums : 
                  PutDST(TRUE);
                  stidp^.dstaddr := gDSTc;
                  StartDST;
                  EnterDSTByte (DST$K_ENUMBEG);
                  EnterDSTByte (size*8);
                  EnterDSTByte (0);
                  lidptr := fcstp;
                  WHILE lidptr <> NIL DO
                    WITH lidptr^ DO
                      PutDST (TRUE);
                      StartDST;
                      EnterDSTByte (DST$K_ENUMELT);
                      EnterDSTByte (DST$K_VALKIND_LITERAL);
                      EnterDSTWord (cvalue.value);
                      SearchSpellTable (name, ename);
                      LoadName (ename, TRUE);
                      lidptr := link;
                    END;
                  END;
                  PutDST (TRUE);
                  StartDST;
                  EnterDSTByte (DST$K_ENUMEND); |
                bools : 
                  PutDST(TRUE);
                  stidp^.dstaddr := gDSTc;
                  StartDST;
                  EnterDSTByte (DST$K_ENUMBEG);
                  EnterDSTByte (size*8);
                  EnterDSTByte (0);
                  StartDST;
                  EnterDSTByte (DST$K_ENUMELT);
                  EnterDSTByte (DST$K_VALKIND_LITERAL);
                  EnterDSTWord (0);
                  LoadName ("FALSE", TRUE);
                  StartDST;
                  EnterDSTByte (DST$K_ENUMELT);
                  EnterDSTByte (DST$K_VALKIND_LITERAL);
                  EnterDSTWord (1);
                  LoadName ("TRUE", TRUE);
                  StartDST;
                  EnterDSTByte (DST$K_ENUMEND); |
                subranges : 
                  IF st <> addrptr THEN
                    Inspect (scalp);
                    PutDST (TRUE);
                    stidp^.dstaddr := gDSTc;
                    StartDST;
                    EnterDSTByte (DST$K_TYPSPEC);
                    EnterDSTByte (0);
                    EnterDSTShortWord (5+lengthOfType+2*lengthOfValue);
                    EnterDSTByte (DST$K_TS_SUBRANGE);
                    EnterDSTWord (size*8);
                    AddDST (lengthOfType+2*lengthOfValue);
                    PutDST (TRUE);
                    LoadType (scalp);
                    LoadValue (min);
                    LoadValue (max);
                  ELSE
                    Inspect(wordptr);
                    PutDST(TRUE);
                    stidp^.dstaddr := gDSTc;
                    StartDST;
                    EnterDSTByte (DST$K_TYPSPEC);
                    EnterDSTByte (0);
                    EnterDSTShortWord (1+lengthOfType);
                    EnterDSTByte (DST$K_TS_TPTR);
                    AddDST (lengthOfType);
                    PutDST (TRUE);
                    LoadType (wordptr);
                  END;
              ELSE CompError;
              END;
            END;
          END;
        END;
      END Inspect;

    BEGIN (* PutVariable *)
      WITH id^ DO
        IF klass = vars THEN
          IF DataType (idtyp) = DSC$K_DTYPE_Z THEN
            Inspect (idtyp);
          END;
          PutDST (TRUE);
          IF state = global THEN
            StartDST;
            EnterDSTByte (DST$K_GLOBNXT);
          END;
          StartDST;
          IF DataType (idtyp) = DSC$K_DTYPE_Z THEN
            EnterDSTByte (DST$K_SEPTYP);
            LoadVariable (id);
            PutDST (TRUE);
            StartDST;
            EnterDSTByte (DST$K_TYPSPEC);
            EnterDSTByte (0);
            AddDST (lengthOfType);
            PutDST (TRUE);
            LoadType (idtyp);
          ELSE
            EnterDSTByte (DataType(idtyp));
            LoadVariable (id);
          END;
        ELSIF klass = mods THEN
          PutGlobals (id);
        END;
      END;
    END PutVariable;

    PROCEDURE PutGlobals (fid: Idptr);
 
      VAR
        lid: Idptr;

    BEGIN
      lid := fid^.expp;
      WHILE lid <> NIL DO
        IF lid^.klass = indrct THEN
          PutVariable(lid^.nxtidp);
        ELSE PutVariable(lid);
        END;
        lid := lid^.link;
      END;
      lid := fid^.locp;
      WHILE lid <> NIL DO
        PutVariable(lid);
        lid := lid^.link;
      END;
    END PutGlobals;

  BEGIN (* PutDebuggerInformation *)
    IF debug THEN
      dflocc := 255;
      IF fidptr = mainmodp THEN
        PutGlobals (fidptr);
      ELSIF fidptr^.klass <> mods THEN
        lid := fidptr^.locp;
        WHILE lid <> NIL DO
          PutVariable(lid);
          lid := lid^.link;
        END;
      END;
      PutDST (FALSE);
      IF grecc <> 0 THEN
        PutRecord;
        grecc := 0;
      END;
    END;
  END PutDebuggerInformation;

  PROCEDURE PutPCCT;

    VAR
      lc, line,
      oldlc: CARDINAL;
      lcdiff,linediff: CARDINAL;

  BEGIN
    PutByte(OBJ$C_TBT);
    INC(grecc);
    StartDST;
    EnterDSTByte(DST$K_LINE_NUM);
    oldlc := 0;
    WHILE GetLine(lc,line) DO
      lcdiff := lc - oldlc;
      linediff := line - oldline - 1;
      IF lDSTc+9 >= maximalDSTRecordSize THEN
        PutDST(FALSE);
        IF grecc = 0 THEN
          PutByte(OBJ$C_TBT);
          INC(grecc);
        END;
        StartDST;
        EnterDSTByte(DST$K_LINE_NUM);
      END;
      IF linediff > 255 THEN
        EnterDSTByte(DST$K_INCR_LINUM_W);
        EnterDSTShortWord(linediff);
      ELSIF linediff > 3 THEN
        EnterDSTByte(DST$K_INCR_LINUM);
        EnterDSTByte(linediff);
      ELSE 
        WHILE linediff > 0 DO
          EnterDSTByte(0);
          DEC(linediff);
        END;
      END;
      IF lcdiff <= 128 THEN
        EnterDSTByte(CARDINAL(-INTEGER(lcdiff)));
      ELSE 
        EnterDSTByte(DST$K_DELTA_PC_W);
        EnterDSTShortWord(lcdiff);
      END;
      oldlc := lc;
      oldline := line;
    END;
    lcdiff := printlc - oldlc;
    IF lcdiff > 255 THEN
      EnterDSTByte(DST$K_TERM_W);
      EnterDSTShortWord(lcdiff);
    ELSIF lcdiff > 0 THEN
      EnterDSTByte(DST$K_TERM);
      EnterDSTByte(lcdiff);
    END;
    PutDST(FALSE);
    IF grecc > 0 THEN
      PutRecord;
      grecc := 0;
    END;
  END PutPCCT;

  PROCEDURE PutModuleStart;

    VAR
      lmodname: SymbolName;

  BEGIN
    SearchSpellTable(mainmodp^.name,lmodname);
    INC(gDSTc,LEN(lmodname)+8);
    PutByte(OBJ$C_TBT);
    PutByte(TIR$C_STA_UB);
    PutByte(1 (* <== location one for DST-start *) );
    PutByte(TIR$C_CTL_DFLOC);
    PutByte(-8-LEN(lmodname));
    PutByte(7+LEN(lmodname));
    PutByte(DST$K_MODBEG);
    PutByte(0 (* <== unused *) );
    PutWord(6 (* <== VAX-11 Pascal *) );
    PutName(lmodname);
    PutRecord;
  END PutModuleStart;

  PROCEDURE PutModuleEnd;

  BEGIN
    INC(gDSTc,2);
    PutByte(OBJ$C_TBT);
    PutByte(-2);
    PutByte(1);
    PutByte(DST$K_MODEND);
    PutRecord;
  END PutModuleEnd;

  PROCEDURE PutProcedureStart(fidptr: Idptr);

    VAR
      lprocname: SymbolName;

  BEGIN
    WITH fidptr^ DO
      SearchSpellTable(name,lprocname);
      INC(gDSTc,LEN(lprocname)+8);
      PutByte(OBJ$C_TBT);
      PutByte(-3);
      PutByte(7+LEN(lprocname));
      PutByte(DST$K_RTNBEG);
      PutByte(0 (* <== unused *) );
      PutByte(TIR$C_STA_SB);
      PutByte(-INTEGER(procnum));
      PutByte(TIR$C_CTL_DFLOC);
      PutByte(-5-LEN(lprocname));
      PutWord(0);
      PutName(lprocname);
      PutRecord;
      PutDebuggerInformation(fidptr);
    END;
  END PutProcedureStart;

  PROCEDURE PutProcedureEnd(procnum, entrypoint, flc: CARDINAL);

  BEGIN
    PutPCCT;
    INC(gDSTc,6);
    PutByte(OBJ$C_TBT);
    PutByte(TIR$C_STA_UB);
    PutByte(2);
    PutByte(TIR$C_CTL_DFLOC);
    PutByte(TIR$C_STA_SB);
    PutByte(-INTEGER(procnum));
    PutByte(TIR$C_CTL_STLOC);
    IF entrypoint <= 7FH THEN
      PutByte(TIR$C_STA_PB);
      PutByte(codePsect);
      PutByte(entrypoint);
    ELSIF entrypoint <= 7FFFH THEN
      PutByte(TIR$C_STA_PW);
      PutByte(codePsect);
      PutShortWord(entrypoint);
    ELSE 
      PutByte(TIR$C_STA_PL);
      PutByte(codePsect);
      PutWord(entrypoint);
    END;
    PutByte(TIR$C_STO_PIDR);
    PutByte(TIR$C_STA_UB);
    PutByte(2);
    PutByte(TIR$C_CTL_STLOC);
    PutByte(-6);
    PutByte(5);
    PutByte(DST$K_RTNEND);
    PutWord(flc);
    PutRecord;
  END PutProcedureEnd;

  PROCEDURE PutSourceFileCorrelation;

    VAR
      XabFhc: XABFHC;
      XabRdt: XABRDT;
      fab   : FABptr;
      change: Keyarr;

  BEGIN
    PutByte(OBJ$C_DBG);
    PutByte(-(2+22+LEN(source)+3+3));
    PutByte(1+22+LEN(source)+3+3);
    PutByte(DST$K_SOURCE);
    PutByte(DST$K_SRC_DECLFILE);
    PutByte(20+LEN(source));
    PutByte(0);
    PutShortWord(0);
    InitXabFhc (XabFhc);
    InitXabRdt (XabRdt);
    fab := Fab(modFile);
    WITH fab^ DO
      XAB := ADR(XabRdt);
      XabRdt.NXT := ADR(XabFhc);
    END;
    IF NOT ODD(SYS$DISPLAY (ADR(fab^), 0, 0))
      THEN
        CompError;
    END;
    change := Keyarr (XabRdt.RDT);
    PutWord(change[0]);
    PutWord(change[1]);
    PutWord(XabFhc.EBK);
    PutShortWord(XabFhc.FFB);
    PutByte(XabFhc.RFO);
    PutByte(LEN(source));
    PutControlledString(source,LEN(source),FALSE);
    PutByte(0);
    PutByte(DST$K_SRC_SETFILE);
    PutShortWord(0);
    PutByte(DST$K_SRC_DEFLINES_W);
    PutShortWord(line);
    PutRecord
  END PutSourceFileCorrelation;

BEGIN (* DebuggerTableHandling *)
  grecc := 0;
  gDSTc := 0;
  lDSTc := 0;
  oldline := 0;
END MVCDebug.