(****************************************
*                                       *
*     MODULA-2 Multi-Pass Compiler      *
*     ****************************      *
*                                       *
*       VAX/VMS Implementation          *
*                                       *
*                                       *
*     MVCLs4:                           *
*                                       *
*     Listing generation in Pass4       *
*                                       * 
*                                       *
*     Version 3.1 of  1-FEB-1983        *
*                                       *
*                                       *
*                                       *
*     Based on PDP11 Implementation     *
*     Version M22 of 22.01.81           *
*                                       *
*     Institut fuer Informatik          *
*     ETH-Zentrum                       *
*     CH-8092 Zuerich                   *
*                                       *
****************************************)

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

IMPLEMENTATION MODULE MVCLs4; (* VAX-11            : M. Mall        *)

  IMPORT SYSTEM, MVCompiler, MVCPublic, MVCLi4, MVCMnemonicsAndTraps,
         OpcodeTable, DateTime, FileSystem, Conversions;
  FROM SYSTEM IMPORT BYTE;
  FROM MVCompiler IMPORT Stptr, Idptr, Stringptr, Idset, Idclass, Spellix,
                         mainmodp, sysmodp, stringcount,
                         stringroot, spelltab;
  FROM MVCLi4 IMPORT LinkerDirective, LinkerTableEntry,
                     SearchSpellTable, NextRelocationPoint, GetLabel, GetLine;
  FROM MVCMnemonicsAndTraps IMPORT Traps;
  FROM OpcodeTable IMPORT OpcodeRange, OpcodeRecord,
                          OPCTAB, XFCTAB;
  FROM DateTime IMPORT ConvertTime;
  FROM Conversions IMPORT ByteToInt, ShortToInt;


  MODULE OutputSystem;

    FROM MVCPublic IMPORT InterOutFile;
    FROM Conversions IMPORT CardToString, IntToString, HexToString;
    FROM FileSystem IMPORT WriteRecord;

    EXPORT Write,Tab,WriteLn,WriteCard,WriteInt,WriteHex,WriteBin;

    CONST
      startpos = 61;

    VAR
      binpos,
      pos: CARDINAL;
      emptybuf,
      outbuf: ARRAY [0..131] OF CHAR;
      cvtbuf: ARRAY [0..12] OF CHAR;

      PROCEDURE Putch (ch: CHAR);

      BEGIN
        IF pos <= HIGH(outbuf) THEN
          outbuf[pos] := ch;
          INC(pos);
        END;
      END Putch;

      PROCEDURE Write (s: ARRAY OF CHAR);

        VAR
          i: CARDINAL;

      BEGIN
        FOR i := 0 TO LEN(s)-1 DO
          Putch(s[i]);
        END;
      END Write;

      PROCEDURE WriteLn;

        VAR
          i: CARDINAL;

      BEGIN
        WriteRecord(InterOutFile,outbuf,pos);
        pos := startpos;
        binpos := startpos;
        outbuf := emptybuf;
      END WriteLn;

      PROCEDURE Tab (to: CARDINAL);

      BEGIN
        INC(to,startpos);
        IF to > pos THEN
          pos := to;
        END;
      END Tab;

      PROCEDURE WriteCard (c: CARDINAL);

      BEGIN
        CardToString(c,0,cvtbuf);
        Write(cvtbuf);
      END WriteCard;

      PROCEDURE WriteInt (i: INTEGER);

      BEGIN
        IntToString(i,0,cvtbuf);
        Write(cvtbuf);
      END WriteInt;

      PROCEDURE WriteHex (c: CARDINAL; len: CARDINAL);

      BEGIN
        HexToString(c,len,cvtbuf);
        Write(cvtbuf);
      END WriteHex;

      PROCEDURE PutBin (ch: CHAR);

      BEGIN
        IF binpos > 0 THEN
          DEC(binpos);
          outbuf[binpos] := ch;
        END;
      END PutBin;

      PROCEDURE WriteBin (c: CARDINAL; len: CARDINAL; reloc: BOOLEAN);

        VAR
          i: CARDINAL;

      BEGIN
        HexToString(c,len,cvtbuf);
        IF reloc THEN
          PutBin("'");
        END;
        FOR i := len-1 TO 0 BY -1 DO
          PutBin(cvtbuf[i]);
        END;
        IF binpos > 0 THEN
          DEC(binpos);
        END;
      END WriteBin;

  BEGIN
    FOR pos := 0 TO HIGH(emptybuf) DO
      emptybuf[pos] := " ";
    END;
    pos := startpos;
    binpos := startpos;
    outbuf := emptybuf;
  END OutputSystem;

  CONST
    maximalSymbolSize = 31;
    labelpos = 8;
    instrpos = 16;
    oprdpos = 24;
    allcpos = labelpos + 33;
    linepos = 71 - 5;

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

  VAR
    baselc,lc: CARDINAL;
    mainmodname: SymbolName;
    trapSet: setOfTraps;

  PROCEDURE WriteLc;

  BEGIN
    Tab(1);    
    WriteHex(baselc+lc,5);
    Tab(labelpos);
  END WriteLc;

  PROCEDURE WriteObjectCode(VAR fctab: ARRAY OF BYTE;
                                flc: CARDINAL;
                                fpfmp: Idptr);

    TYPE
      access = (address, read, modify, write, field, branch);
      datatype = (unknown, byte, word, longword, quadword, octaword, float,
                  d_float, g_float, h_float);

    VAR
      mask: CARDINAL;
      i: CARDINAL;
      name: SymbolName;
      first: BOOLEAN;
      linkrec: LinkerTableEntry;
      line,linelc: CARDINAL;
      morelines, writeline: BOOLEAN;

    PROCEDURE NextByte(VAR byte: CARDINAL);

    BEGIN
      IF lc < flc THEN
        byte := CARDINAL(fctab[lc]);
        INC(lc);
      END;
    END NextByte;

    PROCEDURE GetDisp(length: CARDINAL): CARDINAL;

      VAR
        l: CARDINAL;
        byte: CARDINAL;
        disp: CARDINAL;

    BEGIN
      disp := 0;
      FOR l := 1 TO length DO
        NextByte(byte);
        disp := ASH(byte,(l-1)*8) + disp;
      END;
      RETURN disp;
    END GetDisp;

    PROCEDURE WriteRegister (R: CARDINAL);

    BEGIN
      CASE R OF
        0,1,2,3,4,5,6,7,8,9,10,11: Write("R");
          WriteCard(R); |
        12: Write("AP"); |
        13: Write("FP"); |
        14: Write("SP"); |
        15: Write("PC")
      END (* CASE *)
    END WriteRegister;

    PROCEDURE VaxInstruction;

      VAR
        argnum: CARDINAL;
        numargs: CARDINAL;
        disp: CARDINAL;
        Op: OpcodeRecord;
        opcode: OpcodeRange;

      PROCEDURE WriteLabel(lab: CARDINAL);

      BEGIN
        WriteCard(lab);
        Write("$");
      END WriteLabel;

      PROCEDURE GetWriteOpcode(VAR Op: OpcodeRecord);

        VAR
          lab: CARDINAL;

      BEGIN
        WriteLc;
        IF GetLabel(lc,lab) THEN
          WriteLabel(lab);
          Write(":");
        END;
        Tab(instrpos);
        NextByte(opcode);
        IF opcode = 0FDH THEN
          NextByte(opcode);
          Op := XFCTAB[opcode];
          WriteBin(0FDH+100H*opcode,4,FALSE);
        ELSE 
          Op := OPCTAB[opcode];
          WriteBin(opcode,2,FALSE);
        END;
        Write( Op.Name );
        Tab(oprdpos);
      END GetWriteOpcode;

      PROCEDURE CaseInstr (limit: CARDINAL);

        VAR
          i,llc,disp,lab: CARDINAL;

      BEGIN
        llc := lc;
        FOR i := 0 TO limit DO
          WriteLc;
          disp := GetDisp(2);
          WriteBin(disp,4,FALSE);
          disp := ShortToInt(disp);
          INC(disp,llc);
          Tab(instrpos+4);
          IF GetLabel(disp,lab) THEN
            WriteLabel(lab);
          ELSE Write("^X");
            WriteHex(disp,4);
          END;
          WriteLn;
        END
      END CaseInstr;

      PROCEDURE GetWriteOperand (ac: access; dt: datatype);

        VAR
          mode,reg: CARDINAL;
          length: CARDINAL;
          pcAddressing: BOOLEAN;
          brAddressing: BOOLEAN;
          reloc: BOOLEAN;
          indexed: BOOLEAN;
          indexreg: CARDINAL;
          value: CARDINAL;
          lab: CARDINAL;

        PROCEDURE GetDisplacement;

        BEGIN
          CASE mode OF
            8: IF NOT pcAddressing THEN
                 RETURN
               END; |
            9: IF pcAddressing THEN
                 length := 4
               ELSE RETURN
               END; |
            10,11: length := 1; |
            12,13: length := 2; |
            14,15: length := 4;
          ELSE RETURN
          END;
          disp := GetDisp(length);
        END GetDisplacement;

        PROCEDURE WriteRegDefer;

        BEGIN
          IF pcAddressing THEN
            IF mode < 10 THEN
              Write("(PC)")
            END
          ELSE 
            Write("(");
            WriteRegister(reg);
            Write(")")
          END
        END WriteRegDefer;

        PROCEDURE WriteReloc(linkrec: LinkerTableEntry; offset: CARDINAL);

          VAR
            syname: SymbolName;

        BEGIN
          WITH linkrec DO
            CASE dir OF
              RefLocVariable : 
                SearchSpellTable(nptr^.name,syname);
                Write(syname);
                offset := offset - nptr^.vaddr;
                IF offset <> 0 THEN
                  Write("+");
                  WriteInt(offset);
                END; |
              RefLocConstant : 
                Write("C.$");
                WriteHex(offset,0); |
              RefSystemData : 
                Write(mainmodname);
                Write(".$DATA$"); |
              RefRuntimeSupport : 
                INCL(trapSet,trap);
                CASE trap OF
                  IllegalPointerError, IndexError, FunctionReturnError,
                  HaltCode : 
                    Write("LIB$SIGNAL"); |
                  NewProcessCode : 
                    Write("MOD$NEWPROCESS"); |
                  TransferCode : 
                    Write("MOD$TRANSFER");
                END; |
              RefExtVariable : 
                IF NOT nptr^.globmodp^.foreign THEN
                  SearchSpellTable(nptr^.globmodp^.name,syname);
                  Write(syname);
                  Write(".");
                END;
                SearchSpellTable(nptr^.name,syname);
                Write(syname); |
              RefLocProc : 
                SearchSpellTable(procix^.name,syname);
                Write(syname); |
              RefExtProc : 
                WITH procix^ DO
                  IF NOT globmodp^.foreign THEN
                    SearchSpellTable(globmodp^.name,syname);
                    Write(syname);
                    Write(".");
                  END;
                  SearchSpellTable(name,syname);
                  Write(syname);
                END; |
              RefExtMod : 
                WITH modix^ DO
                  SearchSpellTable(name,syname);
                  Write(syname);
                END;
            END;
          END;
          WriteBin(0,8,TRUE);
        END WriteReloc;

        PROCEDURE WriteSymbol (fid: Idptr; offset: CARDINAL);

          VAR
            syname: SymbolName;
            lid: Idptr;

        BEGIN
          WHILE (fid<>NIL) AND ((fid^.klass<>vars) OR (fid^.vaddr>offset)) DO
            fid := fid^.link
          END;
          lid := fid;
          WHILE (fid<>NIL) AND (lid^.vaddr<>offset) DO
            IF (fid^.klass=vars) AND (fid^.vaddr<=offset) AND
               (fid^.vaddr>lid^.vaddr) THEN
              lid := fid;
            END;
            fid := fid^.link;
          END;
          IF lid <> NIL THEN
            SearchSpellTable(lid^.name,syname);
            Write(syname);
            offset := offset-lid^.vaddr;
            IF offset <> 0 THEN
              Write("+");
              WriteInt(offset);
            END;
          ELSE WriteInt(offset);
          END;
        END WriteSymbol;

      BEGIN
        brAddressing := ac = branch;
        indexed := FALSE;
        CASE dt OF
          byte: length := 1; |
          word: length := 2; |
          longword, float: length := 4; |
          quadword, d_float, g_float: length := 8; |
          octaword, h_float: length := 16;
        END;
        IF brAddressing THEN
          disp := GetDisp(length);
          WriteBin(disp,length*2,FALSE);
          IF length = 1 THEN
            disp := ByteToInt(disp);
          ELSE disp := ShortToInt(disp);
          END;
          INC(disp,lc);
          IF GetLabel(disp,lab) THEN
            WriteLabel(lab);
          ELSE WriteHex(baselc+disp,0);
          END;
        ELSE 
          NextByte(value);
          mode := value DIV 16;
          reg := value MOD 16;
          IF mode = 4 THEN
            indexed := TRUE;
            indexreg := reg;
            NextByte(value);
            mode := value DIV 16;
            reg := value MOD 16;
            WriteBin(4*16+indexreg+100H*value,4,FALSE);
          ELSE
            WriteBin(value,2,FALSE);
          END;
          pcAddressing := reg = 15;
          reloc := (linkrec.linkpoint = lc) AND first;
          GetDisplacement;
          IF (mode > 8) AND ODD(mode) THEN
            Write("@")
          END;
          CASE mode OF
            0,1,2,3: Write("#");
              WriteCard(value);
              disp := value; |
            5: WriteRegister(reg); |
            6: WriteRegDefer; |
            7: Write("-");
              WriteRegDefer; |
            8,9: IF pcAddressing THEN
                   Write('#');
                   IF reloc THEN
                     WriteReloc(linkrec,disp);
                   ELSIF mode = 9 THEN
                     WriteHex(disp,0);
                     WriteBin(disp,8,FALSE);
                   ELSE WriteInt(disp);
                     WriteBin(disp,length*2,FALSE);
                   END
                 ELSE 
                   WriteRegDefer;
                   Write("+")
                 END
          ELSE 
            IF reloc THEN
              WriteReloc(linkrec,disp);
            ELSE 
              WriteBin(disp,length*2,FALSE);
              IF length = 1 THEN
                disp := ByteToInt(disp);
              ELSIF length = 2 THEN
                disp := ShortToInt(disp);
              END;
              IF reg = 13 (*FP*) THEN
                WriteSymbol(fpfmp^.locp,disp);
              ELSE WriteInt(disp);
              END;
            END;
            WriteRegDefer;
          END (*CASE*);
          IF indexed THEN
            Write("[");
            WriteRegister(indexreg);
            Write("]");
          END;
          IF (linkrec.linkpoint <= lc) AND first THEN
            first := NextRelocationPoint(linkrec);
          END;
        END (* NOT brAddressing *);
      END GetWriteOperand;

    BEGIN (*VaxInstruction*)
      writeline := lc = linelc;
      GetWriteOpcode(Op);
      numargs := CARDINAL(Op.Args[0]);
      FOR argnum := 1 TO numargs DO
        GetWriteOperand(VAL(access,CARDINAL(Op.Args[argnum]) MOD 8),
                        VAL(datatype,CARDINAL(Op.Args[argnum]) DIV 8));
        IF argnum < numargs THEN
          Write(',')
        END
      END;
      IF writeline THEN
        Tab(linepos);
        Write("; ");
        WriteCard(line);
      END;
      WriteLn;
      IF ((opcode=08FH) OR (opcode=0AFH) OR (opcode=0CFH)) THEN
        CaseInstr(disp)
      END;
      IF morelines AND (lc > linelc) THEN
        morelines := GetLine(linelc,line);
      END;
    END VaxInstruction;

    PROCEDURE WriteSymbols (fid: Idptr);

      VAR
        syname: SymbolName;

    BEGIN
      IF fid <> NIL THEN
        Tab(labelpos);
        Write("; Symbols for procedure ");
        Write(name);
        WriteLn;
        WHILE fid <> NIL DO
          IF fid^.klass = vars THEN
            SearchSpellTable(fid^.name,syname);
            Tab(instrpos);
            Write(syname);
            Write(" = ");
            WriteInt(fid^.vaddr);
            WriteBin(fid^.vaddr,8,FALSE);
            WriteLn;
          END;
          fid := fid^.link;
        END;
      END;
    END WriteSymbols;

  BEGIN (*WriteObjectCode*)
    lc := 0;
    WriteLn;
    SearchSpellTable(fpfmp^.name,name);
    IF (fpfmp^.klass <> mods) THEN
      WriteSymbols(fpfmp^.locp);
    ELSE 
      Tab(labelpos);
      Write("; Initialization code of module ");
      Write(name);
      WriteLn;
    END;
    IF (fpfmp <> mainmodp) OR NOT fpfmp^.externalaccess THEN
      WriteLc;
      Write(name);
      Write(":");
      WriteLn;
    END;
    WriteLc;
    Tab(instrpos);
    IF fpfmp^.externalaccess THEN
      Write(".ENTRY  ");
      Write(mainmodname);
      IF fpfmp <> mainmodp THEN
        Write(".");
        Write(name);
      END;
      Write(",");
    ELSE 
      Write(".WORD   ");
    END;
    morelines := GetLine(linelc,line);
    mask := GetDisp(2);
    WriteBin(mask,4,FALSE);
    Write("^M<");
    first := TRUE;
    FOR i := 0 TO 11 DO
      IF i IN BITSET(mask) THEN
        IF NOT first THEN
          Write(",")
        END;
        WriteRegister(i);
        first := FALSE;
      END;
    END;
    Write(">");
    IF linelc = (lc-2) THEN
      Tab(linepos);
      Write("; ");
      WriteCard(line);
    END;
    WriteLn;
    IF morelines AND (lc > linelc) THEN
      morelines := GetLine(linelc,line);
    END;
    first := NextRelocationPoint(linkrec);
    WHILE lc < flc DO
      VaxInstruction;
    END;
    INC(baselc,lc);
    lc := 0;
  END WriteObjectCode;

  PROCEDURE WriteConstantPsect;

    TYPE
      AnyString = ARRAY [0..1] OF CHAR;
      AnyStringPtr = POINTER TO AnyString;

    VAR
      strp: Stringptr;

    PROCEDURE PutAnyString(astrp: AnyStringPtr);

      VAR
        n: CARDINAL;
        ch: CHAR;

    BEGIN
      n := 0;
      (*$T-*)
      WHILE astrp^[n] <> 0C DO
        Write(astrp^[n]);
        INC(n);
      END;
      (*$T=*)
      INC(lc,n+1);
    END PutAnyString;

  BEGIN (*WriteConstantPsect*)
    WriteLn;
    Tab(labelpos);
    Write("; String storage section");
    WriteLn;
    Tab(instrpos);
    Write(".PSECT  MODULA2.$STRINGS$,PIC,REL,SHR,RD,LONG");
    WriteLn;
    IF stringcount > 0 THEN
      lc := 0;
      strp := stringroot;
      WHILE strp <> NIL DO
        WITH strp^ DO
          WriteLc;
          Write("C.$");
          WriteHex(loadoffset,0);
          Write(":");
          Tab(instrpos);
          Write(".ASCIZ /");
          PutAnyString(AnyStringPtr(valentry));
          Write("/");
          WriteLn;
          strp := slink;
        END;
      END;
    END;
  END WriteConstantPsect;

  PROCEDURE WriteHeader;

    PROCEDURE WriteDataPsect;

      PROCEDURE WriteModulData (fid: Idptr);

        VAR
          lexpp: Idptr;
          lmodname: SymbolName;
          exporloc: SymbolName;
          first: BOOLEAN;

        PROCEDURE WriteVariable(fid: Idptr);

          VAR
            syname: SymbolName;
            length: CARDINAL;

        BEGIN
          IF fid^.klass = vars THEN
            WITH fid^ DO
              IF first THEN
                WriteLn;
                Tab(labelpos);
                Write(exporloc);
                Write(lmodname);
                WriteLn;
                first := FALSE;
              END;
              IF vaddr <> (lc-4) THEN
                WriteLc;
                Tab(instrpos);
                Write(". = ^X");
                WriteHex(vaddr+4,0);
                lc := vaddr + 4;
                WriteLn;
              END;
              WriteLc;
              SearchSpellTable(name,syname);
              Write(syname);
              Write(":");
              Tab(allcpos);
              Write(".BLKB   ");
              WriteCard(idtyp^.size);
              WriteLn;
              INC(lc,idtyp^.size);
            END
          ELSIF fid^.klass = mods THEN
            WriteModulData(fid);
          END;
        END WriteVariable;

      BEGIN
        SearchSpellTable(fid^.name,lmodname);
        first := TRUE;
        exporloc := "; Exported variables of module ";
        lexpp := fid^.expp;
        WHILE lexpp <> NIL DO
          IF lexpp^.klass = indrct THEN
            WriteVariable(lexpp^.nxtidp);
          ELSE WriteVariable(lexpp);
          END;
          lexpp := lexpp^.link;
        END;
        first := TRUE;
        exporloc := "; Local variables of module ";
        lexpp := fid^.locp;
        WHILE lexpp <> NIL DO
          WriteVariable(lexpp);
          lexpp := lexpp^.link;
        END;
      END WriteModulData;

    BEGIN (*WriteDataPsect*)
      WriteLn;
      Tab(labelpos);
      Write("; Global data storage section");
      WriteLn;
      Tab(instrpos);
      Write(".PSECT  MODULA2.$DATA$,PIC,REL,WRT,RD,LONG");
      WriteLn;
      lc := 0;
      WriteLc;
      Write(mainmodname);
      Write(".$DATA$");
      Write("::");
      Tab(allcpos);
      Write(".LONG   0");
      WriteLn;
      INC(lc,4);
      WriteModulData(mainmodp);
    END WriteDataPsect;

  BEGIN (* WriteHeader *)
    SearchSpellTable(mainmodp^.name,mainmodname);
    Tab(instrpos);
    Write(".TITLE ");
    Write(mainmodname);
    WriteLn;
    Tab(instrpos);
    Write(".IDENT /V01/");
    WriteLn;
    WriteDataPsect;
    WriteConstantPsect;
    WriteLn;
    Tab(labelpos);
    Write("; Program code section");
    WriteLn;
    Tab(instrpos);
    Write(".PSECT  MODULA2.$CODE$,PIC,REL,SHR,RD,EXE,LONG");
    WriteLn;
  END WriteHeader;


  PROCEDURE WriteTrailer;

    PROCEDURE WriteExternals;

      VAR
        lmodp: Idptr;
        lmodname: SymbolName;

      PROCEDURE WriteImport;

        VAR
          lexpp, lnxtidp: Idptr;
          lpfname: SymbolName;
          key: ARRAY [0..22] OF CHAR;

      BEGIN (*WriteImport*)
        IF NOT lmodp^.foreign THEN
          Tab(instrpos);
          Write(".EXTERNAL ");
          Write(lmodname);
          Tab(allcpos);
          Write("; Key: ");
          ConvertTime(lmodp^.modulekey,key);
          Write(key);
          WriteLn;
          IF lmodp^.used  THEN
            Tab(instrpos);
            Write(".EXTERNAL ");
            Write(lmodname);
            Write(".$DATA$");
            WriteLn;
          END;
        END;
        lexpp := lmodp^.expp;
        WHILE lexpp <> NIL DO
          WITH lexpp^ DO
            IF klass = indrct THEN
              lnxtidp := nxtidp
            ELSE lnxtidp := lexpp
            END;
            WITH lnxtidp^ DO
              IF (klass IN Idset{pures,funcs}) AND used OR
                 (klass=vars) AND lmodp^.foreign THEN
                SearchSpellTable(name,lpfname);
                Tab(instrpos);
                Write(".EXTERNAL ");
                IF NOT lmodp^.foreign THEN
                  Write(lmodname);
                  Write(".");
                END;
                Write(lpfname);
                WriteLn;
              END;
            END;
            lexpp := link;
          END;
        END;
      END WriteImport;

    BEGIN (*WriteExternals*)
      WriteLn;
      Tab(labelpos);
      Write("; External symbols");
      WriteLn;
      lmodp := sysmodp^.link;
      WHILE lmodp <> NIL DO
        WITH lmodp^ DO
          SearchSpellTable(name,lmodname);
          IF lmodp <> mainmodp THEN
            WriteImport;
          END;
          lmodp := link;
        END;
      END;
      IF trapSet <> setOfTraps{} THEN
        Tab(instrpos);
        Write(".EXTERNAL ");
        IF (trapSet * setOfTraps{IndexError,
                                 IllegalPointerError,
                                 FunctionReturnError,
                                 HaltCode}) <> setOfTraps{} THEN
          Write("LIB$SIGNAL");
          IF (trapSet * setOfTraps{NewProcessCode,TransferCode})
             <> setOfTraps{} THEN
            Write(",");
          END;
        END;
        IF NewProcessCode IN trapSet THEN
          Write("MOD$NEWPROCESS");
          IF TransferCode IN trapSet THEN
            Write(",");
          END;
        END;
        IF TransferCode IN trapSet THEN
          Write("MOD$TRANSFER");
        END;
        WriteLn;
      END;
    END WriteExternals;

    PROCEDURE WriteVectorPsect;

      VAR
        lexpp, lnxtidp: Idptr;
        lpfname: SymbolName;

    BEGIN
      lexpp := mainmodp^.expp;
      IF lexpp <> NIL THEN
        lc := 0;
        baselc := 0;
        WriteLn;
        Tab(labelpos);
        Write("; Transfer vector section");
        WriteLn;
        Tab(instrpos);
        Write(".PSECT  MODULA2.$VECTOR$,PIC,REL,SHR,RD,EXE,LONG");
        WriteLn;
        WriteLc;
        Tab(instrpos);
        Write(".TRANSFER ");
        Write(mainmodname);
        WriteLn;
        WriteLc;
        Tab(instrpos);
        Write(".MASK     ");
        Write(mainmodname);
        WriteLn;
        INC(lc,2);
        WriteLc;
        Tab(instrpos);
        Write(".JMP      ");
        Write(mainmodname);
        Write("+2");
        WriteLn;
        INC(lc,6);
        WHILE lexpp <> NIL DO
          WITH lexpp^ DO
            IF klass = indrct THEN
              lnxtidp := nxtidp
            ELSE lnxtidp := lexpp
            END;
            WITH lnxtidp^ DO
              IF klass IN Idset{pures,funcs} THEN
                SearchSpellTable(name,lpfname);
                WriteLc;
                Tab(instrpos);
                Write(".TRANSFER ");
                Write(mainmodname);
                Write(".");
                Write(lpfname);
                WriteLn;
                WriteLc;
                Tab(instrpos);
                Write(".MASK     ");
                Write(mainmodname);
                Write(".");
                Write(lpfname);
                WriteLn;
                INC(lc,2);
                WriteLc;
                Tab(instrpos);
                Write(".JMP      ");
                Write(mainmodname);
                Write(".");
                Write(lpfname);
                Write("+2");
                WriteLn;
                INC(lc,6);
              END;
            END;
            lexpp := link;
          END;
        END;
      END;
    END WriteVectorPsect;

  BEGIN
    WriteExternals;
    WriteVectorPsect;
    WriteLn;
    WriteLc;
    Tab(instrpos);
    Write(".END    ");
    Write(mainmodname);
    WriteLn;
  END WriteTrailer;

BEGIN
  lc := 0;
  baselc := 0;
END MVCLs4.