*DECK ASM2                                                               ASM2 
USETEXT CCTTEXT 
USETEXT DNTEXT
          PROC  ASM2;                                                    ASM2 
                                                                         ASM2 
          BEGIN                                                          ASM2 
                                                                         ASM2 
 # * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * # ASM2 
 #                                                                     # ASM2 
 #                                                                     # ASM2 
 #               S T R U C T U R E                                     # ASM2 
 #                                                                     # ASM2 
 #                                                                     # ASM2 
 #   STRUCTURE                                                         # ASM2 
 #                                                                     # ASM2 
 #   GLOBAL ITEM AND ARRAY DECLARATIONS                                # ASM2 
 #                                                                     # ASM2 
 #   DECLARATION OF STATUS SYMBOLS FOR OPCODES                         # ASM2 
 #                                                                     # ASM2 
 #   DECLARATIONS OF EXTERNAL PROCEDURES                               # ASM2 
 #                                                                     #
 #   ASM2ABORT                                                         #
 #                                                                     # ASM2 
 #   TABLELOOKUP                                                       #
 #                                                                     #
 #   LISTOCTAL                                                         # ASM2 
 #                                                                     #
 #   SETCHAR                                                           #
 #                                                                     #
 #   WRITECOMPASS                                                      #
 #                                                                     #
 #   LENLJZF                                                           #
 #                                                                     #
 #   PUTADDR                                                           #
 #                                                                     #
 #   FIXLOCATION                                                       #
 #                                                                     # ASM2 
 #    LINKTABLE                                                        #
  
 #   IDTABLES                                                          #
  
 #   LNTBLDMP                                                          #
  
 #   PDSYMDMP                                                          #
  
 #   DDSYMDMP                                                          #
 #                                                                     #
 #   OBJCODEPARM                                                       # ASM2 
 #                                                                     #
 #   OBJBDP                                                            #
 #                                                                     #
 #   OBJBSS                                                            #
 #                                                                     # ASM2 
 #   OBJCODE                                                           # ASM2 
 #                                                                     #
 #   OBJDATA                                                           #
 #                                                                     #
 #   OBJEND$                                                           #
 #                                                                     #
 #   OBJIM                                                             #
 #                                                                     #
 #   OBJIDENT                                                          #
 #                                                                     #
 #   OBJLABEL                                                          #
 #                                                                     #
 #   OBJLINE                                                           #
 #                                                                     #
 #   OBJNOTE                                                           #
  
 #   OBJOVLY                                                           #
 #                                                                     #
 #   OBJREPL                                                           #
 #                                                                     #
 #   OBJUSE                                                            #
 #                                                                     #
 #   OBJVFD                                                            #
 #                                                                     # ASM2 
 #   INITIALIZE                                                        # ASM2 
 #                                                                     # ASM2 
 #   EXTRACTPARMS                                                      # ASM2 
 #                                                                     # ASM2 
 #   PUTLDST                                                           #
 #                                                                     #
 #   GENOBJECTS                                                        # ASM2 
 #                                                                     # ASM2 
 #   SETASMLINE                                                        # ASM2 
 #                                                                     # ASM2 
 #   FINISH                                                            # ASM2 
 #                                                                     # ASM2 
 #   ASM2                    (MAIN CONTROL ROUTINE)                    #
 #                                                                     # ASM2 
 # * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * # ASM2 
 CONTROL EJECT;                                                          ASM2 
  
  
          ITEM  LISTO        B = TRUE;                                   ASM2 
          ITEM  BLOCKNAME    I = 0; 
                                                                         ASM2 
          ITEM  CODELENGTH   I; 
          ITEM  COMCOUNT     I = 0;    # EXTERNAL COMMON BLOCK COUNT   #
          ITEM  COMMENT30    I; 
          ITEM  COMPASS      B;        # WRITE COMPASS SOURCE FILE     #
          ITEM  ENTRYADDRESS I; 
          ITEM  I             I;
          ITEM  IDENTNAME    I;        # IDENT NAME, LEFT-JUST. ZERO-FL#
          ITEM  INSTRUCTIONS I;                                          ASM2 
          ITEM  INSTR        I;                                          ASM2 
          ITEM  LEN          I;        #LENGTH OF PROGRAM-ID           #
          ITEM  LINENUM      I;        # CURRENT SOURCE LINE NUMBER    #
          ITEM  MINUS$FLAG   I;        #PUT MINUS IN COL 1 FLAG        #
          ITEM  LINKNAME C(7);
          ITEM  LOCATION; 
          ITEM  NEXTWORK; 
          ITEM  OPCODE       I;                                          ASM2 
          ITEM CURRENT$OVL I;         # CURRENT OVERLAY NUMBER #
          ITEM  PARM1        I;                                          ASM2 
          ITEM  PARM2        I;                                          ASM2 
          ITEM  PARM3        I;                                          ASM2 
          ITEM  PARM4        I; 
          ITEM  PARM5        I; 
          ITEM  POSITION; 
          ITEM  REL          I; 
          ITEM  RELADDR      I; 
          ITEM  RELCHAR      I; 
          ITEM  TEMP         I; 
          ITEM  USEBEG$ATEMP I;        # USESTART OF ATEMP$ BLOCK      #
          ITEM  USEBEG$CODE  I;        # USESTART OF CODE BLOCK        #
          ITEM  USEBEG$SBTMP;      # USESTART OF SUBSCRIPT TEMPS BLOCK #
          ITEM  USEBLK       I; 
          ITEM  VINDEX; 
          ITEM  EOF          B; 
          ITEM  LISTLINE     B;                                          ASM2 
          ITEM  CODEWORD     I;                                          ASM2 
  
          DEF   COUNT        #LEN#; 
          $BEGIN
*CALL BUG203C 
          $END
  
          COMMON  COMPFIT;
              BEGIN 
              ARRAY COMPASSFIT  [0:9] S(1); 
                  BEGIN 
                  ITEM  COMPFITWORD  U(0, 0,60);
                  END 
              END 
  
          COMMON  DEFEXTS;
              BEGIN 
              ITEM  NEXTDEFS     I;        # NUMBER OF EXTERNAL NAMES  #
              ARRAY  [1:100]  S(1); 
                  BEGIN 
                  ITEM  EXTDEF  C(0,0,7); 
                  ITEM  EXTLINK U(0,42,18); 
                  END 
              END  #DEFEXTS#
*CALL OBJCOMM 
                                                                         ASM2 
*CALL LOCLAB
  
          COMMON  P2TBL1;                                                ASM2 
              BEGIN                                                      ASM2 
              ARRAY  [0:149]  S(4); 
                  BEGIN                                                  ASM2 
                  ITEM  CLASS        U(0,  0,  3);
                  ITEM  LISTSWITCH   U(0,  3,  2);
                  ITEM  COLPARM1     U(0, 30,  5);                       ASM2 
                  ITEM  LENPARM1     U(0, 35,  5);                       ASM2 
                  ITEM  COLPARM2     U(0, 40,  5);                       ASM2 
                  ITEM  LENPARM2     U(0, 45,  5);                       ASM2 
                  ITEM  COLPARM3     U(0, 50,  5);                       ASM2 
                  ITEM  LENPARM3     U(0, 55,  5);                       ASM2 
                  ITEM  PICTURE1     C(1,  0, 10);                       ASM2 
                  ITEM  PICTURE2     C(2,  0, 10);                       ASM2 
                  ITEM  PICTURE3     C(3,  0, 10);
                  END                                                    ASM2 
              END  #P2TBL1#                                              ASM2 
                                                                         ASM2 
          COMMON  P2TBL2;                                                ASM2 
              BEGIN                                                      ASM2 
              ARRAY  [0:149]  S(1);                                      ASM2 
                  BEGIN                                                  ASM2 
                  ITEM  OBJACTION    U(0,  0,  6);
                  ITEM  OBJLENGTH    U(0, 15,  6);                       ASM2 
                  ITEM  OBJACTPARM1  U(0, 21,  3);                       ASM2 
                  ITEM  OBJACTPARM2  U(0, 24,  3);                       ASM2 
                  ITEM  OBJACTPARM3  U(0, 27,  3);                       ASM2 
                  ITEM  OBJPICTURE   U(0, 30, 30);                       ASM2 
                  END                                                    ASM2 
              END  #P2TBL2#                                              ASM2 
                                                                         ASM2 
*CALL USETAB
  
*CALL RALINE
  
          ARRAY  ASMLINE[1:14]  S(1);                                    ASM2 
              ITEM  ASMLINEWD    U(0, 0,60);
  
          ARRAY  COMPASSLINE [5:12] S(1); 
              ITEM  COMPASSLINEW U(0, 0,60);
  
          ARRAY  TEXTTBL[0:17]  S(1);  # 1 EXTRA WORD FOR EASY ZEROING #
              ITEM  TEXTTBLWD    U(0,  0, 60);
  
          ARRAY  LINKTBL[0:100];
              BEGIN 
              ITEM  EXTNAME C(0,0,7); 
              ITEM  LINKCR   U(0,24,36);
              ITEM  LINKTYPE U(0, 0,12);
              ITEM  LINKWC   U(0,12,12);
              ITEM  LINKWORD; 
              ITEM  TBUPPER  U(0, 0,30);
              ITEM  TBLOWER  U(0,30,30);
              END 
          ARRAY FILLTBL[0:0] S(2);
              ITEM
                  FILL$NAME    U(0,00,12),
                  FILL$WC      U(0,12,12),
                  FILL$CR      U(0,39,09),
                  FILL$HEADER  U(1,00,01),
                  FILL$BR      U(1,22,08),
                  FILL$TRAILER U(1,30,01),
                  FILL$P       U(1,31,02),
                  FILL$R       U(1,33,09),
                  FILL$A       U(1,42,18);
  
          ARRAY  XFILLTBL[0:0]  S(2); 
              ITEM
                  XFILL$NAME     U(0,00,12),
                  XFILL$WC       U(0,12,12),
                  XFILL$CR       U(0,39,09),
                  XFILL$A        U(1,06,24),
                  XFILL$POS      U(1,30,06),
                  XFILL$SIZE     U(1,36,06),
                  XFILL$BR       U(1,42,09),
                  XFILL$R        U(1,51,09);
  
              DEF  TEXTTYPE      #B<0,12>TEXTTBLWD[0]#; 
              DEF  TEXTWC        #B<12,12>TEXTTBLWD[0]#;
              DEF  TEXTC         #B<26,1>TEXTTBLWD[0]#; 
              DEF  TEXTR         #B<33,9>TEXTTBLWD[0]#; 
              DEF  TEXTS         #B<42,18>TEXTTBLWD[0]#;
  
  
 CONTROL EJECT; 
  
*CALL DNT 
*CALL PNT 
*CALL NAMET 
*CALL AUXT1 
*CALL AUXTVALS
*CALL UNQSTATUS 
  
*CALL IDBLOCK 
  
          $BEGIN
          ITEM  LINE         C(100);   # DEBUGGING PRINT LINE          #
          ITEM  LAST         I;        # COLUMN POINTER                #
          $END
  
          DEF LORD           #32#;     # LANGUAGE ORDINAL FOR CID TBLS #
  
          ITEM CURLNTBLHDR   I;        # PTR TO CURRENT LINE TBL HDR   #
          ITEM CURLNARYSIZE  I;        # CURRENT SIZE OF LINE TBL ARRAY#
          ITEM DD            I;        # POINTER FOR DDSYM$TBL         #
          ITEM DNTIDX        I;        # POINTER FOR DNT REFERENCES    #
          ITEM PD            I;        # POINTER FOR PDSYM$TBL         #
          ITEM LNWC          I;        # SIZE OF LINE TBL ARRAY        #
          ITEM PNTIDX        I;        # POINTER FOR PNT REFERENCES    #
          ITEM  PNTLEN       I;        # ACTUAL PNT LEN                #
          ITEM ID$LN$PN      I;        # PNAT IDX FOR NXT LN TABL ENTRY#
  
 #    LINE NUMBER TABLE DESCRIPTION FOR INTERACTIVE DEBUG              #
  
          DEF LINETBLNAME    #O"5700"#; #LINE TABLE LOADER NAME        #
          DEF LNTBLENTRYSZ   #1#;      # MAX LINE TBL ENTRY WD SIZE    #
          DEF MAXLNTBLSIZE   #50#;     # MAX NO OF ENTRIES IN A LN TBL #
  
          BASED ARRAY LINENO$TBL [1:1] S(LNTBLENTRYSZ); 
              BEGIN 
              ITEM LINENO$WORD     I(0, 0,60);   # WHOLE WORD          #
 #            HEADER ENTRY                                             #
              ITEM LINENO$NAME     I(0, 0,12);   # TABLE NAME          #
              ITEM LINENO$LORD     I(0,26,10);   # LANGUAGE ORDINAL    #
              ITEM LINENO$WC       I(0,12,12);   # TABLE WORD COUNT    #
 #            DESCRIPTOR ENTRY                                         #
              ITEM LINENO$FWA      I(0,42,18);   # FWA OF RJ DBUG.LN   #
              ITEM LINENO$LN       I(0,24,18);   # SOURCE LINE NUMBER  #
              ITEM LINENO$PN       I(0, 0,18);   # PTR TO PDSYMBOL TBL #
              END 
  
 #     PROCEDURE DIVISION SYMBOL TABLE AND HEADER DESCRITIONS          #
  
          DEF MAXPDTBLSIZE   #1000#;   # MAX SIZE OF PD SYMBOL TBL     #
          DEF PDSYMENTRYSZ   #4#;      # MAX PD TBL ENTRY SIZE         #
          DEF PDSYMTBLNAME   #O"5600"#; #PD LOADER SYMBOL TBL NAME     #
  
          BASED ARRAY PDSYM$TBL [1:MAXPDTBLSIZE] S(PDSYMENTRYSZ); 
              BEGIN 
              ITEM  PDSYM$FWA      I(3,42,18);   # FWA OF PARA OR SECT #
              ITEM  PDSYM$LN       I(3,24,18);   # SOURCE LINE NUMBER  #
              ITEM  PDSYM$LWA      I(3, 6,18);   # LWA OF PARA ONLY    #
              ITEM  PDSYM$NAME     C(0, 0,30);   # PARA/SEC NAME       #
              ITEM  PDSYM$SEC      I(3, 2, 1);   # IFF SECTION NAME    #
              ITEM  PDSYM$UNQ      I(3, 0,02);   # UNIQUENESS OF SYMBOL#
              ITEM  PDSYM$WORD0    I(0, 0,60);   # WORD 0              #
              ITEM  PDSYM$WORD1    I(1, 0,60);   # WORD 1              #
              ITEM  PDSYM$WORD2    I(2, 0,60);   # WORD 2              #
              ITEM  PDSYM$WORD3    I(3, 0,60);   # WORD 3              #
              END 
  
          ITEM  PDSYM$HDR    I;        # PD SYMBOL TABLE HEADER        #
  
 #     FOLLOWING DEFS ARE FIELDS OF THE PD SYMBOL TABLE HEADER         #
  
          DEF  PDSYM$LORD   #B<26,10>PDSYM$HDR#; # LANGUAGE ORDINAL    #
          DEF  PDSYM$LTB    #B<36>PDSYM$HDR#;    # LAST TABLE INDICATOR#
          DEF  PDSYM$PDT    #B<38>PDSYM$HDR#;    # IFF PD SYMBOL TABLE #
          DEF  PDSYM$TNAME  #B<0,12>PDSYM$HDR#;  # TABLE NAME          #
          DEF  PDSYM$WC     #B<12,12>PDSYM$HDR#; # TABLE WORD COUNT    #
  
 #    DATA DIVISION SYMBOL TABLE AND HEADER DESCRIPTIONS               #
  
          DEF  DDSYMENTRYSZ  #6#; 
          DEF  DDSYMTBLNAME  #O"5600"#; 
          DEF  MAXDDTBLSIZE  #600#; 
  
          BASED ARRAY DDSYM$TBL [1:MAXDDTBLSIZE] S(DDSYMENTRYSZ); 
              BEGIN 
              ITEM  DDSYM$BCP      U(5,32, 4);   # BEG CHAR POSITION   #
              ITEM  DDSYM$BWZ      U(4,19, 1);   # IFF BLANK WHEN ZERO #
              ITEM  DDSYM$DDS      U(3,10, 5);   # DATA DIV SECTION    #
              ITEM  DDSYM$DPP      U(4,53, 7);   # DEC POINT LOCATION  #
              ITEM  DDSYM$JST      U(4,18, 1);   # IFF JUSTIFIED       #
              ITEM  DDSYM$LED      U(4, 1, 1);   # LEADING SIGN        #
              ITEM  DDSYM$LENGTH   U(5, 0,18);   # LENGTH IN CHARS     #
              ITEM  DDSYM$LEVEL    U(3, 3, 7);   # LVL NO. OR INDICATOR#
              ITEM  DDSYM$NAME     C(0, 0,30);   # NAME OF SYMBOL      #
              ITEM  DDSYM$OCCDEP   U(3,42,18);   #PTR TO OCC DEP ON ITM#
              ITEM  DDSYM$OCCURS   U(3,24,18);   # NO. OF OCCURRENCES  #
              ITEM  DDSYM$QLF      U(3, 2, 1);   # SYM CAN BE QUALIFIED#
              ITEM  DDSYM$RA       U(5,36,24);   # RELATIVE ADDRESS    #
              ITEM  DDSYM$RB       U(4, 3, 9);   # REL BASE DESIGNATOR #
              ITEM  DDSYM$SEP      U(4, 2, 1);   # SEPERATE SIGN       #
              ITEM  DDSYM$SGN      U(4, 0, 1);   # ITEM IS SIGNED      #
              ITEM  DDSYM$SGNGRP   U(4, 0, 3);   # SIGN GROUP          #
              ITEM  DDSYM$SUBIND   U(4,12, 6);   # NO. OF SUBSCRIPTS   #
              ITEM  DDSYM$TYPE     U(3,15, 5);   # DNAT TYPE           #
              ITEM  DDSYM$UNQ      U(3, 0, 2);   # UNIQUENESS OF SYMBOL#
              ITEM  DDSYM$WORD0    U(0, 0,60);   # WORD 0              #
              ITEM  DDSYM$WORD1    U(1, 0,60);   # WORD 1              #
              ITEM  DDSYM$WORD2    U(2, 0,60);   # WORD 2              #
              ITEM  DDSYM$WORD3    U(3, 0,60);   # WORD 3              #
              ITEM  DDSYM$WORD4    U(4, 0,60);   # WORD 4              #
              ITEM  DDSYM$WORD5    U(5, 0,60);   # WORD 5              #
              END 
  
          ITEM  DDSYM$HDR    I;        # DATA DIV SYMBOL TABLE HEADER  #
  
 #     FOLLOWING ARE DEFS OF FIELDS IN THE DD SYMBOL TABLE HEADER      #
  
          DEF  DDSYM$DPC    #B<39>DDSYM$HDR#;    # DEC POINT IS COMMA  #
          DEF  DDSYM$LORD   #B<26,10>DDSYM$HDR#; # LANGUAGE ORDINAL    #
          DEF  DDSYM$SAVEA1 #B<42,18>DDSYM$HDR#; # SAVE A1 ADDRESS     #
          DEF  DDSYM$TNAME  #B<0,12>DDSYM$HDR#;  # TABLE NAME          #
          DEF  DDSYM$WC     #B<12,12>DDSYM$HDR#; # TABLE WORD COUNT    #
*CALL PNAT1 
  
  
 #                                                                     # ASM2 
 #   DEFINE STATUS SYMBOLS FOR OPCODES                                 # ASM2 
 #                                                                     # ASM2 
                                                                         ASM2 
*CALL OPNAMES                                                            ASM2 
  
*CALL CHAR$ 
  
 #                                                                     #
*CALL DNATVALS
  
*CALL FDLT
*CALL PLT1
*CALL LDSET 
*CALL TABLETYP
*CALL LISTOBJ 
  
 #   STATUS SYMBOLS FOR OBJECT ACTIONS                                 #
 #                                                                     #
*CALL OBJACT
  
*CALL LISTCTL 
 CONTROL EJECT;                                                          ASM2 
  
          XREF  ITEM  LISTHED  C(90);  # FULL LISTING TITLE            #
  
          XREF  ITEM  LISTTYP  C(20);  # TYPE FIELD OF LISTING TITLE   #
  
          XREF  ITEM  UPTR     I;      # COMPASS OUTPUT FILE POINTER   #
  
          XREF  ITEM GROUP1FLAG I;     # FLAG SET IF GROUP 1 BLOCK ASGD#
  
          XREF  FUNC CMM$AGR    I;     # ALLOCATE GROUP                #
  
          XREF  FUNC CMM$ALV    I;     # ALOCATE VARIABLE BLOCK        #
  
          XREF  PROC CMM$FRV;          # FREE VARIABLE BLOCK           #
  
          XREF  PROC CMM$GLV;          # GROW VARIABLE BLOCK           #
  
          XREF  PROC TMREOP;           # REOPEN VIRTUAL TABLES         #
  
          XREF  PROC  READINS;                                           ASM2 
                                                                         ASM2 
          XREF  PROC  OPNLIST;                                           ASM2 
                                                                         ASM2 
          XREF  PROC  PRTLIST;                                           ASM2 
                                                                         ASM2 
          XREF  PROC  CLSLIST;                                           ASM2 
                                                                         ASM2 
          XREF  FUNC  RSHIFT;                                            ASM2 
                                                                         ASM2 
          XREF  PROC  ABORT;                                             ASM2 
  
          XREF  PROC  CBLIST;           # WRITE COBOL LISTING          #
  
          XREF  PROC  RETRN;       # CLOSE FILE, RETURN BUFFERS        #
  
          XREF  FUNC  DEC      C(10);  # DECIMAL DISPLAY REPRESENTATION#
  
          XREF  PROC  FILLRBZ;         # FILL RIGHT BLANKS W/ BIN. ZER.#
  
          XREF  PROC  INSOPEN;         # OPEN PSEUDO-INSTRUCTION FILE  #
  
          XREF  PROC  OUTPUT ;     #PRINT ERROR MESSAGES #
          XREF  FUNC  OCT     C(20);   # BINARY TO DISPLAY CODE OCTAL  #
  
          XREF  ITEM  PRFXNAM      I;  # DECK NAME FOR PRFX TABLE      #
  
          XREF  PROC  PUTBIN;          # *PUT* RECORD ON BINARY FILE   #
  
          XREF  PROC  PUTLINK;         # *PUT* LINK/LINKX TABLE        #
  
          XREF  PROC  PUTPIDL;         # *PUT* PIDL TABLE              #
  
          XREF  PROC  PUTPRFX;         # *PUT* PREFIX TABLE            #
  
          XREF  PROC  PUTSQ;           # WRITE A RECORD ON A SEQ. FILE #
  
          XREF  PROC  PUTWEOR;         # WRITE EOR ON BINARY FILE      #
  
          XREF  PROC  TMRTNTB;         #RETURN VIRTUAL TABLE           #
  
          XREF  FUNC  VIRTUAL;         # VIRTUALIZE A TABLE INDEX      #
  
  
  
  
 #                                                                     #
 #   *DEF* SYMBOLS                                                     #
 #                                                                     #
          CONTROL EJECT;
          PROC ASM2ABORT(N);
  
  
          BEGIN 
          ITEM  N            I; 
  
          ITEM  ABORTMSG     C(40)=" COBOL SYSTEM ERROR, PLEASE REPORT";
          ITEM  ABORTMSG1    C(20) = "LINE =              ";
  
  
          $BEGIN
              GOTO SKIP25ABT; 
          $END
          IF N EQ 25 THEN RETURN; 
 SKIP25ABT: 
          IF LISTO  THEN
              CBLIST(1, ASMLINE, 136);
  
          CBLIST(1, ABORTMSG, 40);
  
          C<0,6>TEMP = " ASM2-";
          C<0,10>PARM1 = DEC(N);
          C<6,4>TEMP = C<0,4>PARM1; 
          CBLIST(1, TEMP, 10);
          C<10,10>ABORTMSG1 = C<0,10>LINENUM; 
          CBLIST(1, ABORTMSG1, 20); 
          IF N NQ 25 THEN ABORT;
  
          END  #ASM2ABORT#
          CONTROL  EJECT; 
          FUNC   BUILDLINK(FIRST);
          ITEM  FIRST;
            ITEM  PF; 
          BEGIN 
          IF  POSITION  EQ 0  THEN  PF = 2; 
              ELSE  IF  POSITION  EQ  15  THEN  PF = 1; 
                  ELSE  IF POSITION  EQ 30 THEN  PF = 0;
                      ELSE
                          BEGIN        #NON-STANDARD RELOCATION        #
                          PUTLINK(LINKNAME,POSITION+12,TEXTR,LOCATION); 
                          RETURN; 
                          END 
          VINDEX = VIRTUAL(TABLETYPE"WORK3$",NEXTWORK); 
          WORK3$LINK[VINDEX] = FIRST; 
          BUILDLINK = NEXTWORK; 
          WORK3$TBIT[VINDEX] = 1; 
          WORK3$A[VINDEX] = LOCATION; 
          WORK3$P[VINDEX] = PF; 
          WORK3$R[VINDEX] = TEXTR;
          NEXTWORK = NEXTWORK + 1;
          RETURN; 
          END 
          CONTROL EJECT;
          PROC TABLELOOKUP(ADDR); 
  
 # * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * #
 #                                                                     #
 #        NAME-  TABLELOOKUP                                           #
 #                                                                     #
 #        GIVEN- GLOBAL VARIABLE *INSTR* IN THE FOLLOWING FORMAT-      #
 #                   12/(IGNORED),                                     #
 #                   18/CONSTANT,  (MAY BE SIGNED)                     #
 #                   4/MOD VALUE,                                      #
 #                   8/TABLE TYPE,                                     #
 #                   18/INDEX TO TABLE                                 #
 #                                                                     #
 #        DOES-  THE APPROPRIATE ADDRESS FIELD OF THE ENTRY INDICATED  #
 #               BY THE TABLE TYPE AND INDEX IS ADDED TO THE CONSTANT  #
 #               AND LEFT IN PARAMETER *ADDR*.                         #
 #                                                                     #
 #        IF THE FIELD IS EXTERNAL, A *LINK* OR *XLINK* TABLE IS       #
 #        GENERATED TO FILL THE 18-BIT FIELD STARTING AT BIT           #
 #        (POSITION+12) (SYMPL NOMENCLATURE) IN WORD (LOCATION) OF     #
 #        BLOCK (TEXTR).                                               #
 #        THE LOWER 6 BITS OF (RELCHAR) ARE SET TO "*".                #
 #                                                                     #
 #        IF A FIELD IS PROGRAM OR COMMON RELOCATABLE,                 #
 #        (REL) IS SET TO THE LOADER NUMBER OF THE BLOCK               #
 #        (NOT *USETAB* INDEX).                                        #
 #        THE LOWER 6 BITS OF (RELCHAR) ARE SET TO "+" OR "<LETTER>".  #
 #                                                                     #
 # * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * #
  
  
          BEGIN 
  
          ITEM  ADDR         I; 
  
  
          ITEM  CONST        I; 
          ITEM  LABNO        I; 
          ITEM  TEMP         I; 
          ITEM  I            I; 
          ITEM  INDEX;
  
  
          SWITCH  SPLIT:TABLETYPE 
                         TL$NULL:NULL,
                         TL$ATEMP$:ATEMP$,
                         TL$CCT$:CCT$,
                         TL$DNAT$:DNAT$,
                         TL$EXT$:EXT$,
                         TL$FDLT$:FDLT$,
                         TL$FNAT$:FNAT$,
                         TL$LOCAL$:LOCAL$,
                         TL$OBJ$:OBJ$,
                         TL$PLT$:PLT$,
                         TL$PNAT$:PNAT$,
                         TL$SUBTEMP$:SUBTEMP$,
                         TL$UEXT$:UEXT$,
                         TL$USEORG$:USEORG$,
                         TL$USE$:USETAB$; 
  
  
          CONST = B<12,18>INSTR*2**42;
          CONST = RSHIFT(CONST,42); 
          INDEX = B<42,18>INSTR;
          GOTO SPLIT[B<34,8>INSTR]; 
  
 TL$NULL: 
          ADDR = CONST; 
          RETURN; 
  
 TL$ATEMP$: 
          ADDR = USEBEG$ATEMP + B<42,18>INSTR - 1 + CONST;
          RELADDR = B<42,18>INSTR - 1 + CONST;
          REL = 1;
          RELCHAR = O"45";   #+#
          BLOCKNAME = "ATEMPS"; 
          RETURN; 
  
 TL$CCT$: 
          ADDR = CONST; 
          RETURN; 
  
 TL$DNAT$:  
          IF  DN$MAJMSEC[VIRTUAL(TABLETYPE"DNAT$",INDEX)] EQ LINKMSEC 
          THEN
              BEGIN 
              ADDR = 0; 
              RETURN; 
              END 
          ADDR = DN$WORDOFF[VIRTUAL(TABLETYPE"DNAT$",INDEX)] + CONST; 
          TEMP = DN$SUBMSEC[VIRTUAL(TABLETYPE"DNAT$",INDEX)]; 
          RELADDR = ADDR; 
          IF NOT GLOBAL[TEMP]  THEN 
              ADDR = ADDR + USESTART[TEMP]; 
          REL = USEBLOCK[TEMP]; 
          IF REL EQ 1  THEN 
              RELCHAR = O"45";  #+# 
          ELSE
              RELCHAR = REL - 2;   #A - Z#
          BLOCKNAME = USENAME[TEMP];
          RETURN; 
  
 TL$EXT$: 
          LINKNAME = EXTDEF[INDEX]; 
          C<0,7>COMMENT30 = LINKNAME; 
          EXTLINK[INDEX] = BUILDLINK(EXTLINK[INDEX]); 
          ADDR = CONST; 
         RELADDR = CONST; 
          RELCHAR = O"47";   #*#
          RETURN; 
 TL$FDLT$:  
          I = VIRTUAL(TABLETYPE"FDLT$",B<42,18>INSTR);
          TEMP = 0; 
          C<0,7>TEMP = FDLTINTNAME[I];
          C<0,7>COMMENT30 = C<0,7>TEMP; 
          PUTLINK(TEMP, POSITION+12, TEXTR, LOCATION);
          ADDR = CONST; 
          RELCHAR = O"47";
          RETURN; 
  
 TL$FNAT$:  
          ADDR = CONST; 
          RETURN; 
  
 TL$LOCAL$: 
          LABNO = VIRTUAL(TABLETYPE"WORK4$",B<42,18>INSTR); 
          IF  LABEQU[LABNO] NQ 0
          THEN  LABNO = VIRTUAL(TABLETYPE"WORK4$",LABEQU[LABNO]); 
          ADDR = LABLOCN[LABNO] + CONST;
          RELADDR = ADDR; 
          TEMP = LABBLK[LABNO]; 
          IF NOT GLOBAL[TEMP]  THEN 
              ADDR = ADDR + USESTART[TEMP]; 
          BLOCKNAME = USENAME[TEMP];
          REL = USEBLOCK[TEMP]; 
          IF REL EQ 1  THEN 
              RELCHAR = O"45";  #+# 
          ELSE
              RELCHAR = REL - 2;   #A - Z#
          RETURN; 
  
 TL$OBJ$: 
          LINKNAME = OBJNAM[INDEX]; 
          C<0,7>COMMENT30 = LINKNAME; 
          OBJLINK[INDEX] = BUILDLINK(OBJLINK[INDEX]); 
          ADDR = CONST; 
         RELADDR = CONST; 
          RELCHAR = O"47";   #*#
          RETURN; 
  
 TL$PLT$: 
          ADDR = CONST; 
          RETURN; 
  
 TL$PNAT$:  
          IF  B<30,4>INSTR EQ MODVALUES"LWA$" 
         THEN ADDR = PN$LASTADDR[VIRTUAL(TABLETYPE"PNAT$",INDEX)];
         ELSE ADDR = PN$FIRSTADDR[VIRTUAL(TABLETYPE"PNAT$",INDEX)]; 
          RELADDR = ADDR + CONST; 
          BLOCKNAME = "CODE"; 
          ADDR = USEBEG$CODE + ADDR + CONST;
          REL = 1;
          RELCHAR = O"45";   #+#
          RETURN; 
  
 TL$SUBTEMP$: 
          ADDR = B<42,18>INSTR - 1 + CONST; 
          RELADDR   = ADDR; 
          BLOCKNAME = "SUBTEMP";
          REL = USEBLOCK[SBTMPBLK]; 
          IF  NOT GLOBAL[SBTMPBLK]  THEN ADDR = ADDR + USEBEG$SBTMP;
          IF  REL EQ 1
          THEN  RELCHAR = O"45"; #+#
          ELSE  RELCHAR = REL - 2; #A - Z#
          RETURN; 
  
TL$UEXT$: 
          I = VIRTUAL(TABLETYPE"PLT$", B<42,18>INSTR);
          LABNO = PL$LENGTH[I];   #LENGTH OF NAME#
          I = VIRTUAL(TABLETYPE"PLTSTR$", PL$STRINGPTR[I]); 
          TEMP = 0; 
          C<0,LABNO>TEMP = C<0,LABNO>PLT$CHAR[I]; 
          C<0,LABNO>COMMENT30 = C<0,LABNO>TEMP; 
          PUTLINK(TEMP, 
                  POSITION+12,
                  TEXTR,
                  LOCATION ); 
          ADDR = CONST; 
          RELCHAR = O"47";   #*#
          RETURN; 
  
 TL$USE$: 
          ADDR = O"123456";            # DUMMY REFERENCE               #
          RETURN; 
  
 TL$USEORG$:  
          ADDR = CONST; 
          TEMP = B<42,18>INSTR; 
          IF  NOT GLOBAL[TEMP]  THEN  ADDR = ADDR + USESTART[TEMP]; 
          REL = USEBLOCK[TEMP]; 
          IF  REL EQ 1
          THEN  RELCHAR = O"45";
          ELSE RELCHAR = REL - 2; 
          RETURN; 
          END #TABLELOOKUP# 
 CONTROL EJECT;                                                          ASM2 
          PROC  LISTOCTAL(PARAMETER, COLUMN, LENGTH);                    ASM2 
                                                                         ASM2 
 # * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * # ASM2 
 #                                                                     # ASM2 
 #   NAME -      LISTOCTAL                                             # ASM2 
 #                                                                     # ASM2 
 #   PURPOSE -   INSERT AN OCTAL VALUE INTO *ASMLINE*                  # ASM2 
 #                                                                     # ASM2 
 #   GIVEN -  *PARAMETER* = VALUE OF THE PARAMETER                     # ASM2 
 #            *COLUMN* = LEFT-MOST COLUM OF FIELD                      # ASM2 
 #            *LENGTH* = LENGTH OF FIELD                               # ASM2 
 #                       ZERO IFF PARAMETER IS NOT TO BE INSERTED      # ASM2 
 #                                                                     # ASM2 
 #   DOES -   CONVERTS *PARAMETER* TO OCTAL AND INSERTS                # ASM2 
 #                                                                     # ASM2 
 # * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * # ASM2 
                                                                         ASM2 
                                                                         ASM2 
          BEGIN                                                          ASM2 
                                                                         ASM2 
          ITEM  PARAMETER    I;                                          ASM2 
          ITEM  COLUMN       I;                                          ASM2 
          ITEM  LENGTH       I;                                          ASM2 
                                                                         ASM2 
          ITEM  PARM         I;                                          ASM2 
          ITEM  COL          I;                                          ASM2 
          ITEM  LENGTHINDEX  I;                                          ASM2 
          ITEM  DIGIT        I;                                          ASM2 
          ITEM  WORDINDEX    I;                                          ASM2 
          ITEM  CHARNUM      I;                                          ASM2 
                                                                         ASM2 
                                                                         ASM2 
           IF  LENGTH NQ 0                                               ASM2 
          THEN                                                           ASM2 
              BEGIN                                                      ASM2 
              PARM = PARAMETER;                                          ASM2 
              COL = COLUMN + LENGTH - 1;                                 ASM2 
              FOR  LENGTHINDEX=1  STEP 1  UNTIL LENGTH  DO               ASM2 
                  BEGIN                                                  ASM2 
                  DIGIT = (PARM LAN O"7") + O"33";                       ASM2 
                  WORDINDEX = (COL + 9) / 10;                            ASM2 
                  CHARNUM = COL - (10 * WORDINDEX) + 9;                  ASM2 
                  C<CHARNUM,1>ASMLINEWD[WORDINDEX] = C<9,1>DIGIT;        ASM2 
                  PARM = RSHIFT(PARM, 3);                                ASM2 
                  COL = COL - 1;                                         ASM2 
                  END  #LENGTHINDEX#                                     ASM2 
              END  #LENGTH NQ 0#                                         ASM2 
          END  #LISTOCTAL#                                               ASM2 
 CONTROL EJECT; 
          PROC SETCHAR(COLUMN, CHAR); 
  
 # * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * #
 #                                                                     #
 #   NAME -      SETCHAR                                               #
 #                                                                     #
 #   DOES -      INSERTS SPECIFIED CHARACTER INTO SPECIFIED COLUMN     #
 #                 OF ASMLINE.                                         #
 #                                                                     #
 # * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * #
  
          BEGIN 
          ITEM  COLUMN       I; 
          ITEM  CHAR         I; 
  
          ITEM  WORDINDEX    I; 
          ITEM  CHARNUM      I; 
  
          WORDINDEX = (COLUMN + 9) / 10;
          CHARNUM = COLUMN - (10*WORDINDEX) + 9;
          C<CHARNUM,1>ASMLINEWD[WORDINDEX] = C<9,1>CHAR;
  
          END  #SETCHAR#
 CONTROL EJECT; 
          PROC  WRITECOMPASS; 
  
 # * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * #
 #                                                                     #
 #   WRITECOMPASS -  WRITE COMPASS CARD IMAGE                          #
 #                                                                     #
 #   GIVEN -  CARD IMAGE IN ASMLINE[5:12]                              #
 #                                                                     #
 #   DOES -  WRITES OUT LINE ON /COMPFIT/                              #
 #                                                                     #
 # * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * #
  
  
          BEGIN 
          ITEM  I            I;        # SCRATCH                       #
  
          FOR I = 5 STEP 1 UNTIL 12  DO 
              COMPASSLINEW[I] = ASMLINEWD[I]; 
          PUTSQ(UPTR, LOC(COMPASSLINE), 80);
          END 
 CONTROL EJECT; 
          FUNC LENLJZF(NAME); 
 # * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * #
 #                                                                     #
 #   NAME -      LENLJZF                                               #
 #                                                                     #
 #   PURPOSE -   RETURNS LENGTH OF LEFT-JUSTIFIED ZERO-FILLED NAME     #
 #                                                                     #
 # * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * #
  
          BEGIN 
          ITEM  NAME         I; 
  
          LENLJZF = 7;
          IF B<36,6>NAME EQ 0  THEN LENLJZF = 6;
          IF B<30,6>NAME EQ 0  THEN LENLJZF = 5;
          IF B<24,6>NAME EQ 0  THEN LENLJZF = 4;
          IF B<18,6>NAME EQ 0  THEN LENLJZF = 3;
          IF B<12,6>NAME EQ 0  THEN LENLJZF = 2;
          IF B<06,6>NAME EQ 0  THEN LENLJZF = 1;
          END  #LENLJZF#
 CONTROL EJECT; 
          PROC   PUTADDR(COL);
 # * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * #
 #                                                                     #
 #  NAME -       PUTADDR                                               #
 #                                                                     #
 #  PURPOSE -    PLACE BLOCK NAME AND RELATIVE ADDRESS ON ASSEMBLY LIST#
 #                                                                     #
 #  GIVEN -      COL IS STARTING COLUMN NUMBER,                        #
 #               BLOCKNAME CONTAINS THE BLOCK NAME,                    #
 #               RELADDR IS THE RELATIVE ADDRESS WITHIN THE BLOCK.     #
 #                                                                     #
 #  DOES -       OBTAINS CHAR COUNT ON BLOCKNAME AND MOVES IT AND A    #
 #               "+" TO ASMLINE.  THEN CALLS LISTOCTAL TO CONVERT AND  #
 #               PLACE THE ADDRESS.                                    #
 #                                                                     #
 # * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * #
  
  
          BEGIN 
  
          ITEM   COL         I; 
          ITEM   I           I; 
          ITEM   INDX        I; 
          ITEM   OFFSET      I; 
  
  
          INDX = (COL + 9) / 10;
          OFFSET = COL - (INDX *10) + 9;
          IF  BLOCKNAME EQ 0  THEN
              BLOCKNAME = COMMENT30;
          FOR  I = 1 STEP 1 WHILE 
              I LQ 7 AND
              ( C<9,1>BLOCKNAME EQ " " OR C<9,1>BLOCKNAME EQ 0 )  DO
              BLOCKNAME = RSHIFT(BLOCKNAME, 6); 
  
          IF  BLOCKNAME NQ "CODE"  THEN 
              BEGIN 
              LEN = 7;
              FOR I = 18  STEP 6 UNTIL 54  DO 
                  IF  B<I,6>BLOCKNAME NQ 0 THEN 
                      TEST; 
                  ELSE
                      LEN = LEN - 1;
              I = 10 - LEN; 
              IF  COMMENT30 EQ "          "  THEN 
                  C<OFFSET,1>ASMLINEWD[INDX] = "#"; 
              ELSE
                  BEGIN 
                  C<OFFSET,1>ASMLINEWD[INDX] = "="; 
                  OFFSET = OFFSET + 1;
                  IF  OFFSET GQ 10  THEN
                      BEGIN 
                      OFFSET = OFFSET - 10; 
                      INDX = INDX + 1;
                      END 
                  C<OFFSET,1>ASMLINEWD[INDX] = "X"; 
                  LEN = LEN + 1;
                  END 
              OFFSET = OFFSET + 1;
              IF  OFFSET GQ 10  THEN
                  BEGIN 
                  OFFSET = OFFSET - 10; 
                  INDX = INDX + 1;
                  END 
              FOR  I = I STEP 1 UNTIL 9  DO 
                  BEGIN 
                  C<OFFSET,1>ASMLINEWD[INDX] = C<I,1>BLOCKNAME; 
                  OFFSET = OFFSET + 1;
                  IF  OFFSET GQ 10  THEN
                      BEGIN 
                      OFFSET = OFFSET - 10; 
                      INDX = INDX + 1;
                      END 
                  END 
              IF  RELADDR EQ 0  THEN
                  GOTO PUTDONE; 
              C<OFFSET,1>ASMLINEWD[INDX] = "+"; 
              LISTOCTAL(RELADDR,COL+LEN+2, 6);
              OFFSET = OFFSET + 7;
              IF  OFFSET GQ 10  THEN
                  BEGIN 
                  OFFSET = OFFSET - 10; 
                  INDX = INDX + 1;
                  END 
              C<OFFSET,1>ASMLINEWD[INDX] = "B"; 
              OFFSET = OFFSET + 1;
              END 
          ELSE
              BEGIN 
              LEN = LENLJZF(IDENTNAME); 
          FOR I = 0 STEP 1 UNTIL LEN-1 DO 
              BEGIN 
              C<OFFSET,1>ASMLINEWD[INDX] = C<I,1>IDENTNAME; 
              OFFSET = OFFSET + 1;
              IF OFFSET GQ 10 
              THEN
                  BEGIN 
                  OFFSET = OFFSET - 10; 
                  INDX = INDX  + 1; 
                  END 
              END 
              IF  RELADDR EQ 0  THEN
                  GOTO PUTDONE; 
              C<OFFSET,1>ASMLINEWD[INDX] = "+"; 
              LISTOCTAL(RELADDR, COL+LEN+1, 6); 
              OFFSET = OFFSET + 7;
              IF  OFFSET GQ 10  THEN
                  BEGIN 
                  OFFSET = OFFSET - 10; 
                  INDX = INDX + 1;
                  END 
              C<OFFSET,1>ASMLINEWD[INDX] = "B"; 
              OFFSET = OFFSET + 1;
              END 
  
 PUTDONE: 
          RELADDR = 0;
          IF  OFFSET GQ 10  THEN
              BEGIN 
              OFFSET = OFFSET - 10; 
              INDX = INDX + 1;
              END 
          C<OFFSET,1>ASMLINEWD[INDX] = " "; 
          BLOCKNAME = 0;
          COMMENT30 = "          "; 
          RETURN; 
  
          END    #PUTADDR#
 CONTROL EJECT; 
          PROC  FIXLOCATION;
 # * * * * * * * * * * * * * * * * * *  * * * * * * * * * * * * * * * # 
 #                                                                     #
 #    NAME -     FIXLOCATION                                           #
 #                                                                     #
 #    GIVEN -    *LOCATION* = CURRENT LOCATION                         #
 #               *POSITION* = CURRENT POSITION                         #
 #               *CODELENGTH* = NUMBER OF BITS DESIRED                 #
 #               *TXTTBL*                                              #
 #                                                                     #
 #    DOES -     MAKES SURE ENOUGH ROOM IS IN                          #
 #               TEXTTBLWD[TEXTWC+1].                                  #
 #               THE TEXT TABLE IS FLUSHED IF NECESSARY                #
 #                                                                     #
 # * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * #
  
          BEGIN 
          IF   LOCATION LS TEXTS
            OR LOCATION GR TEXTS + 14 
            OR ((LOCATION EQ TEXTS+14) AND (POSITION+CODELENGTH GR 60)) 
            THEN
              BEGIN 
              PUTBIN(LOC(TEXTTBL), TEXTWC+1); 
              TEXTWC = 1; 
              TEXTTBLWD[1] = 0; 
              TEXTR = USEBLOCK[USEBLK]; 
              TEXTTBLWD[2] = 0; 
              TEXTS = LOCATION; 
              END 
          IF POSITION EQ 0  THEN
              TEXTTBLWD[TEXTWC+1] = 0;
          END #FIXLOCATION# 
          CONTROL  EJECT; 
          PROC  LINKTABLE;
 #                                                                     #
 #        NAME - LINKTABLE                                             #
 #        GIVEN -  OBJLINK - INITIAL LINKS FOR OBJECT ROUTINE REFS     #
 #                 EXTLINK - INITIAL LIMKS FOR EXTERNAL NAME REFS      #
#                  WORK5 - LINKED LIST OF OBJ AND EXT REFERENCES       #
 #        DOES - GATHERS ALL REFERENCES TO EACH EXTERNAL FORM WORKS    #
 #               INTO A LINK TABLE AND OUTPUTS IT TO BINARY FILE       #
 #                                                                     #
          ITEM  I;
          ITEM  J;
          ITEM LINK;
          ITEM  LINKINDEX;
          PROC  LINKLIST; 
 #   GENERATE A LINK TABLE FOR A SINGLE EXTERNAL                       #
          BEGIN 
          LINKCR[0] = 0;
          LINKTYPE[0] = O"4400";
          LINKWORD[1] = 0;
          EXTNAME[1] = LINKNAME;
          IF  LISTO OR COMPASS  THEN
              BEGIN 
              IF  LISTLINE AND LISTO  THEN
                  CBLIST(1, ASMLINE, 136);
              IF  LISTLINE AND COMPASS  THEN
                  WRITECOMPASS; 
              C<0,10>BLOCKNAME = LINKNAME;
              RELADDR = 0;
              PUTADDR(58);
              SETCHAR(58, O"55");  # BLANK OUT PUTADDR-S LEAD CHAR     #
              LISTLINE = TRUE;
              END 
          J = 0;
          LINKINDEX = 2;
          FOR  J=J WHILE LINK NQ 0 DO 
              BEGIN 
              VINDEX = VIRTUAL(TABLETYPE"WORK3$",LINK); 
              LINK = WORK3$LINK[VINDEX];
              IF  J EQ 0
              THEN  TBUPPER[LINKINDEX] = WORK3$TRL[VINDEX]; 
              ELSE  TBLOWER[LINKINDEX] = WORK3$TRL[VINDEX]; 
              IF  J EQ 1  THEN LINKINDEX = LINKINDEX + 1; 
              J = 1 - J;
              IF  LINKINDEX GR 100
              THEN
                  BEGIN 
                  LINKWC[0] = 100;
                  PUTBIN(LOC(LINKTBL),101); 
                  LINKINDEX = 2;
                  END 
              END 
          IF  J  EQ 0 AND LINKINDEX EQ 2  THEN  RETURN; 
          IF  J EQ 0
          THEN  LINKINDEX = LINKINDEX - 1;
          ELSE  TBLOWER[LINKINDEX] = 0; 
          LINKWC[0] = LINKINDEX;
          PUTBIN(LOC(LINKTBL),LINKINDEX+1); 
          RETURN; 
          END 
          BEGIN 
          IF  LISTO OR COMPASS  THEN
              BEGIN 
              FOR  J = 1 STEP 1 UNTIL 14  DO
                  ASMLINEWD[J] = "          ";
              ASMLINEWD[6] = "EXT       ";
              ASMLINEWD[11] = LINENUM;
              END 
          FOR  I = 1 STEP 1 UNTIL NOBJRTN DO
              BEGIN 
              IF  OBJLINK[I] EQ 0  THEN  TEST;
              LINKNAME = OBJNAM[I]; 
              LINK = OBJLINK[I];
              LINKLIST; 
              END 
          FOR  I = 1 STEP 1 UNTIL NEXTDEFS DO 
              BEGIN 
              IF  EXTLINK[I] EQ 0 THEN TEST;
              LINKNAME = EXTDEF[I]; 
              LINK = EXTLINK[I];
              LINKLIST; 
              END 
          RETURN; 
          END 
CONTROL EJECT;
          PROC   IDTABLES;
  
 # * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * #
 #                                                                     #
 #   NAME -      IDTABLES                                              #
 #                                                                     #
 #   PURPOSE -   TO OUTPUT LINE NUMBER AND SYMBOL TABLES FOR CID       #
 #                                                                     #
 #   GIVEN -     BLOCK CONTAINING LINE NUMBER TABLES AND               #
 #               PNAT,PNT,DNAT,DNT,AUXT,NAMET                          #
 #                                                                     #
 #   DOES -      WRITES LINE NUMBER, PROCEDURE AND DATA DIVISION       #
 #               SYMBOL LOADER TABLES TO BINARY FILE                   #
 #                                                                     #
 # * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * #
  
  
          BEGIN 
  
  
          ITEM  C10          C(10); 
          ITEM  OFFSET       I; 
  
  
 #   WRITE LINE NUMBER TABLES TO BINARY FILE                           #
  
          FOR I = 1 STEP MAXLNTBLSIZE WHILE I LS CURLNTBLHDR DO 
              BEGIN 
              $BEGIN
              IF BUG203C$CID THEN 
                  LNTBLDMP(I);
              $END
              PUTBIN(LOC(LINENO$WORD[I]),MAXLNTBLSIZE); 
              END 
  
          LINENO$WC[CURLNTBLHDR] = LNWC - CURLNTBLHDR;
          $BEGIN
          IF BUG203C$CID THEN 
              LNTBLDMP(CURLNTBLHDR);
          $END
          PUTBIN(LOC(LINENO$WORD[CURLNTBLHDR]),LNWC-CURLNTBLHDR+1); 
          CMM$FRV(LINENO$TBL);
  
 #    WRITE DATA DIVISION SYMBOL TABLES                                #
  
          DDSYM$HDR = 0;
          DDSYM$TNAME = DDSYMTBLNAME; 
          DDSYM$LORD = LORD;
          DDSYM$WC = MAXDDTBLSIZE * DDSYMENTRYSZ; 
          IF CCTDECPOINT EQ "," THEN
              DDSYM$DPC = 1;
          VINDEX = VIRTUAL(TABLETYPE"WORK4$",SAVEA1); 
          IF LABEQU[VINDEX] NQ 0 THEN 
              VINDEX = VIRTUAL(TABLETYPE"WORK4$",LABEQU[VINDEX]); 
          DDSYM$SAVEA1 = LABLOCN[VINDEX]; 
          RELADDR = DDSYM$SAVEA1; 
          TEMP = LABBLK[VINDEX];
          IF NOT GLOBAL[TEMP] THEN
              DDSYM$SAVEA1 = DDSYM$SAVEA1 + USESTART[TEMP]; 
          IF CCTDNTLEN GR MAXDDTBLSIZE THEN 
              TEMP = CMM$ALV(MAXDDTBLSIZE*DDSYMENTRYSZ,1,3,GROUP1FLAG,
                                                       P<DDSYM$TBL>,0); 
          ELSE
              TEMP = CMM$ALV(CCTDNTLEN*DDSYMENTRYSZ,1,3,GROUP1FLAG, 
                                                      P<DDSYM$TBL>,0);
          DD = 0; 
          FOR DNTIDX = 1 STEP 1 UNTIL CCTDNTLEN DO
              BEGIN 
              DD = DD + 1;
              VINDEX = VIRTUAL(TABLETYPE"DNT$",DNTIDX); 
              DDSYM$WORD0[DD] = 0;
              DDSYM$WORD1[DD] = 0;
              DDSYM$WORD2[DD] = 0;
              DDSYM$WORD3[DD] = 0;
              DDSYM$WORD4[DD] = 0;
              DDSYM$WORD5[DD] = 0;
              DDSYM$UNQ[DD] = DNTIDUNQ[VINDEX]; 
  
#             PLACE NAME INTO DESCRIPTOR                               #
  
              IF DNTNAMETPTR[VINDEX] NQ 0 THEN
                  BEGIN 
                  I = DNTNBRWORDS[VINDEX] - 1;
                  VINDEX = DNTNAMETPTR[VINDEX]; 
                  OFFSET = 0; 
                  C10=NAMET$CHARS[VIRTUAL(TABLETYPE"NAMET$",VINDEX+I)]; 
                  FOR OFFSET = OFFSET WHILE C<OFFSET>C10 NQ " " AND 
                                            OFFSET LS 10  DO
                      OFFSET = OFFSET + 1;
                  IF I EQ 0 THEN
                      C<0,OFFSET>DDSYM$WORD0[DD] = C<0,OFFSET>C10;
                  ELSE
                      BEGIN 
                      DDSYM$WORD0[DD] = 
                         NAMET$CHARS[VIRTUAL(TABLETYPE"NAMET$",VINDEX)];
                      IF I EQ 1 THEN
                          C<0,OFFSET>DDSYM$WORD1[DD] = C<0,OFFSET>C10;
                      ELSE
                          BEGIN 
                          DDSYM$WORD1[DD] = 
                       NAMET$CHARS[VIRTUAL(TABLETYPE"NAMET$",VINDEX+1)];
                          C<0,OFFSET>DDSYM$WORD2[DD] = C<0,OFFSET>C10;
                          END 
                      END 
                  END 
  
              VINDEX = VIRTUAL(TABLETYPE"DNAT$",DNTIDX);
              DDSYM$LEVEL[DD] = DN$LEVEL[VINDEX]; 
              DDSYM$DDS[DD] = DN$MAJMSEC[VINDEX]; 
              DDSYM$TYPE[DD] = DN$TYPE[VINDEX]; 
              DDSYM$SGNGRP[DD] = DN$SIGNGRP[VINDEX];
              DDSYM$JST[DD] = DN$JUST[VINDEX];
              DDSYM$BWZ[DD] = DN$BZERO[VINDEX]; 
              DDSYM$DPP[DD] = DN$POINT[VINDEX]; 
              IF DN$TYPE[VINDEX] EQ INDXNAME
              THEN
                  BEGIN 
                  DDSYM$LENGTH[DD] = 10;
                  DDSYM$BCP[DD] = 0;
                  END 
              ELSE
                  BEGIN 
              DDSYM$LENGTH[DD] = DN$ITMLEN[VINDEX]; 
              DDSYM$BCP[DD] = DN$CHARPOS[VINDEX]; 
                  END 
              IF(DN$LEVEL[VINDEX] GR 01 AND DN$LEVEL[VINDEX] LS 50) OR
                 DN$LEVEL[VINDEX] EQ 66 OR
                 DN$LEVEL[VINDEX] EQ 88 OR
                ((DN$LEVEL[VINDEX] EQ 01) AND 
                 (DN$MAJMSEC[VINDEX] EQ FDMSEC OR 
                  DN$MAJMSEC[VINDEX] EQ SDMSEC OR 
                  DN$MAJMSEC[VINDEX] EQ CDMSEC OR 
                  DN$MAJMSEC[VINDEX] EQ RDMSEC))
              THEN
                  DDSYM$QLF[DD] = 1;
              IF DN$MAJMSEC[VINDEX] NQ LINKMSEC THEN
                  BEGIN 
                  TEMP = DN$SUBMSEC[VINDEX];
                  DDSYM$RB[DD] = USEBLOCK[TEMP];
                  DDSYM$RA[DD] = DN$WORDOFF[VINDEX] + USESTART[TEMP]; 
                  END 
      ELSE
          BEGIN 
          DDSYM$RA[DD] = DN$WORDOFF[VINDEX];
          DDSYM$RB[DD] = DN$SUBMSEC[VINDEX];
          END 
              IF DN$SDEPTH[VINDEX] NQ 0 THEN
                  BEGIN 
                  DDSYM$SUBIND[DD] = DN$SDEPTH[VINDEX]; 
                  IF DN$OCCURS[VINDEX] NQ 0 THEN
                      BEGIN 
                      VINDEX = DN$AUXREF[VINDEX]; 
              FOR VINDEX = VINDEX WHILE VINDEX NQ 0 
              DO
                  BEGIN 
                  IF AX$TTYPE[VIRTUAL(TABLETYPE"AUX$",VINDEX)] EQ 
                     MAXOCCUR 
                  AND AX$SUBSLVL[VIRTUAL(TABLETYPE"AUX$",VINDEX)] EQ
                      DDSYM$SUBIND[DD]
                  THEN
                      BEGIN 
                      DDSYM$OCCURS[DD] =
                           AX$MAXOCCNO[VIRTUAL(TABLETYPE"AUX$",VINDEX)];
                      VINDEX = 0; 
                      END 
                  ELSE
                      VINDEX =
                           AX$TNEXTPTR[VIRTUAL(TABLETYPE"AUX$",VINDEX)];
                  END 
  
                      IF DN$DEP[VIRTUAL(TABLETYPE"DNAT$",DNTIDX)] NQ 0
                      THEN
                          BEGIN 
                          VINDEX =
                           DN$AUXREF[VIRTUAL(TABLETYPE"DNAT$",DNTIDX)]; 
                          FOR VINDEX = VINDEX WHILE VINDEX NQ 0 AND 
                              AX$TTYPE[VIRTUAL(TABLETYPE"AUX$",VINDEX)] 
                                            NQ VAROCCUR 
                          DO
                              VINDEX =
                           AX$TNEXTPTR[VIRTUAL(TABLETYPE"AUX$",VINDEX)];
  
                          DDSYM$OCCDEP[DD] =
                             AX$DEPNAM[VIRTUAL(TABLETYPE"AUX$",VINDEX)];
                          END 
                      END 
                  END 
  
              IF DD EQ MAXDDTBLSIZE THEN
                  BEGIN 
                  PUTBIN(LOC(DDSYM$HDR),1); 
                  PUTBIN(LOC(DDSYM$TBL),MAXDDTBLSIZE*DDSYMENTRYSZ); 
                  $BEGIN
                  IF BUG203C$CID THEN DDSYMDMP(MAXDDTBLSIZE); 
                  $END
                  DD = 0; 
                  END 
              END 
  
          IF DD NQ 0 THEN 
              BEGIN 
              DDSYM$WC = DD * DDSYMENTRYSZ; 
              PUTBIN(LOC(DDSYM$HDR),1); 
              PUTBIN(LOC(DDSYM$TBL),DD*DDSYMENTRYSZ); 
              $BEGIN
              IF BUG203C$CID THEN DDSYMDMP(DD); 
              $END
              END 
  
 #   WRITE PROCEDURE DIVISION SYMBOL TABLES                            #
  
          PDSYM$HDR = 0;
          PDSYM$TNAME = PDSYMTBLNAME; 
          PDSYM$LORD = LORD;
          PDSYM$PDT = 1;
          PDSYM$WC = MAXPDTBLSIZE * PDSYMENTRYSZ; 
          IF PNTLEN GR MAXPDTBLSIZE THEN
              TEMP = CMM$ALV(MAXPDTBLSIZE*PDSYMENTRYSZ,1,3,GROUP1FLAG,
                                                       P<PDSYM$TBL>,0); 
          ELSE
              TEMP = CMM$ALV(PNTLEN*PDSYMENTRYSZ,1,3,GROUP1FLAG,
                                                        P<PDSYM$TBL>,0);
  
          PD = 0; 
          FOR PNTIDX = 1 STEP 1 UNTIL PNTLEN DO 
              BEGIN 
              PD = PD + 1;
              PDSYM$WORD0[PD] = 0;
              PDSYM$WORD1[PD] = 0;
              PDSYM$WORD2[PD] = 0;
              PDSYM$WORD3[PD] = 0;
              VINDEX = VIRTUAL(TABLETYPE"PNT$",PNTIDX); 
              PDSYM$UNQ[PD] = PNTIDUNQ[VINDEX]; 
              PDSYM$LN[PD] = PNTLINE[VINDEX]; 
              PDSYM$SEC[PD] = PNTSECTION[VINDEX]; 
  
 #            PLACE NAME IN DESCRIPTOR                                 #
  
              IF PNTNAMETPTR[VINDEX] NQ 0 THEN
                  BEGIN 
                  I = PNTNBRWORDS[VINDEX] - 1;
                  VINDEX = PNTNAMETPTR[VINDEX]; 
                  OFFSET = 0; 
                  C10=NAMET$CHARS[VIRTUAL(TABLETYPE"NAMET$",VINDEX+I)]; 
                  FOR OFFSET = OFFSET WHILE C<OFFSET>C10 NQ " " AND 
                                            OFFSET LS 10  DO
                      OFFSET = OFFSET + 1;
                  IF I EQ 0 THEN
                      C<0,OFFSET>PDSYM$WORD0[PD] = C<0,OFFSET>C10;
                  ELSE
                      BEGIN 
                      PDSYM$WORD0[PD] = 
                         NAMET$CHARS[VIRTUAL(TABLETYPE"NAMET$",VINDEX)];
                      IF I EQ 1 THEN
                          C<0,OFFSET>PDSYM$WORD1[PD] = C<0,OFFSET>C10;
                      ELSE
                          BEGIN 
                          PDSYM$WORD1[PD] = 
                       NAMET$CHARS[VIRTUAL(TABLETYPE"NAMET$",VINDEX+1)];
                          C<0,OFFSET>PDSYM$WORD2[PD] = C<0,OFFSET>C10;
                          END 
                      END 
                  END 
  
              VINDEX = VIRTUAL(TABLETYPE"PNAT$",PNTIDX);
              PDSYM$FWA[PD] = PN$FIRSTADDR[VINDEX]; 
              PDSYM$LWA[PD] = PN$FIRSTADDR[VINDEX+1] - 1; 
  
              IF PD EQ MAXPDTBLSIZE THEN
                  BEGIN 
                  IF PNTIDX EQ PNTLEN THEN PDSYM$LTB = 1; 
                  $BEGIN
                  IF BUG203C$CID THEN PDSYMDMP(MAXPDTBLSIZE); 
                  $END
                  PUTBIN(LOC(PDSYM$HDR),1); 
                  PUTBIN(LOC(PDSYM$TBL),MAXPDTBLSIZE*PDSYMENTRYSZ); 
                  PD = 0; 
                  END 
              END 
  
          IF PD NQ 0 THEN 
              BEGIN 
              PDSYM$LTB = 1;
              PDSYM$WC = PD * PDSYMENTRYSZ; 
              PUTBIN(LOC(PDSYM$HDR),1); 
              PUTBIN(LOC(PDSYM$TBL),PD*PDSYMENTRYSZ); 
              $BEGIN
              IF BUG203C$CID THEN PDSYMDMP(PD); 
              $END
              END 
  
          RETURN; 
          END 
          CONTROL EJECT;
 # * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * #
 #                                                                     #
 #    LNTBLDMP - CID LINE TABLE DUMP                                   #
 #                                                                     #
 #    DOES - DUMPS THE LINE TABLE ARRAY                                #
 #                                                                     #
 # * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * #
          $BEGIN
  
          PROC LNTBLDMP(HDR); 
  
          BEGIN 
  
          ITEM  I            I; 
          ITEM  HDR          I; 
          ITEM  TITLE        C(30) = " LINE NUMBER TABLE DUMP       ";
          ITEM  HDRTITLE     C(53) =
                "HEADER WORD OCTAL    NAME  WC  LORD / DEC -  WC  LORD";
          ITEM  DESTITLE     C(70) =
                "DESCRIPTOR WORD OCT    PN     LN    FWA   / DEC -  PN
   LN            "; 
  
          LINE = " "; 
          CBLIST(LISTCTL"SKIPPRINT",TITLE,30);
          CBLIST(LISTCTL"SKIPPRINT",HDRTITLE,53); 
          C<0,20>LINE = OCT(LINENO$WORD[HDR],0,20); 
          C<21,4>LINE = OCT(LINENO$WORD[HDR],0,4);    #NAME#
          C<26,4>LINE = OCT(LINENO$WORD[HDR],4,4);    #WC#
          C<31,4>LINE = OCT(LINENO$WORD[HDR],8,4);    #LORD#
          C<45,4>LINE = DEC(LINENO$WC[HDR]);
          C<50,4>LINE = DEC(LINENO$LORD[HDR]);
          CBLIST(LISTCTL"LINE",LINE,70);
          CBLIST(LISTCTL"SKIPPRINT",DESTITLE,70); 
          LINE = " "; 
          FOR I = HDR + 1 STEP 1 UNTIL LINENO$WC[HDR] + HDR DO
              BEGIN 
              C<0,20>LINE = OCT(LINENO$WORD[I],0,20); 
              C<21,6>LINE = OCT(LINENO$WORD[I],0,6);   #PN# 
              C<28,6>LINE = OCT(LINENO$WORD[I],8,6);   #LN# 
              C<36,6>LINE = OCT(LINENO$WORD[I],14,6); #FWA# 
              C<51,6>LINE = DEC(LINENO$PN[I]);
              C<58,6>LINE = DEC(LINENO$LN[I]);
              CBLIST(LISTCTL"LINE",LINE,70);
              END 
          RETURN; 
          END 
          CONTROL EJECT;
 # * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * #
 #                                                                     #
 #    PDSYMDMP - PROCEDURE DIVISION SYMBOL TABLE DUMP                  #
 #                                                                     #
 #    GIVEN - SIZE OF TABLE                                            #
 #                                                                     #
 #    DOES - DUMPS CURRENT CONTENTS OF PDSYM$TBL W/ PDSYM$HDR          #
 #                                                                     #
 # * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * #
          PROC PDSYMDMP(SIZE);
  
          BEGIN 
  
          ITEM  PDTTITLE     C(90) = "HEADER WORD OCTAL    NAME  WC  LOR
D LTB PDT / DEC -  WC  LORD  -- PDSYMBOL TABLE DUMP    "; 
          ITEM  PDTDESTITLE C(100) = "             NAME              UNQ
 SEC   LWA     LN    FWA   DESCRIPTOR WORD OCT  / DEC -   LN      ";
  
          ITEM C1            C(1);
          ITEM C20           C(20); 
          ITEM I             I; 
          ITEM J             I; 
          ITEM SIZE          I; 
  
  
          LINE = " "; 
          CBLIST(LISTCTL"EJECT"); 
          CBLIST(LISTCTL"SKIPPRINT",PDTTITLE,90); 
          C20 = OCT(PDSYM$HDR,0,20);
          C<0,20>LINE = C20;
          C<21,4>LINE = C<0,4>C20;   # NAME # 
          C<26,4>LINE = C<4,4>C20;   # WC   # 
          C<31,4>LINE = C<8,4>C20;   # LORD # 
          C1 = C<12>C20;
          IF C1 EQ "5" OR C1 EQ "4" THEN C<37>LINE = "1";  # LTB #
          IF C1 EQ "1" OR C1 EQ "5" THEN C<41>LINE = "1";  # PDT #
          C<53,4>LINE = DEC(PDSYM$WC);
          C<59,4>LINE = DEC(PDSYM$LORD);
          CBLIST(LISTCTL"LINE",LINE,90);
          LINE = " "; 
          CBLIST(LISTCTL"SUBTITLE",PDTDESTITLE,100);
          CBLIST(LISTCTL"SKIPPRINT",PDTDESTITLE,100); 
          CBLIST(LISTCTL"LINE",LINE,10);
          FOR I = 1 STEP 1 UNTIL SIZE DO
              BEGIN 
              C<0,30>LINE = PDSYM$NAME[I];
              LAST = 0;   # BLANK OUT TRAILING ZEROS                   #
              FOR LAST=LAST WHILE C<LAST>LINE NQ O"00" AND LAST LS 30 DO
                  LAST = LAST + 1;
              IF LAST NQ 30 THEN
              C<LAST,30-LAST>LINE = " ";
              IF PDSYM$UNQ[I] EQ UNQ"UNIQUE" THEN C<32,3>LINE = "UNQ";
              ELSE IF PDSYM$UNQ[I] EQ UNQ"LAST" THEN C<32,3>LINE="LST"; 
              ELSE IF PDSYM$UNQ[I] EQ UNQ"FIRST" THEN C<32,3>LINE="FST";
              ELSE C<32,3>LINE = "BTW"; 
              IF PDSYM$SEC[I] NQ 0
              THEN C<36>LINE = "1"; 
              ELSE C<36>LINE = "0"; 
              C<39,6>LINE = OCT(PDSYM$WORD3[I],2,6);  #LWA# 
              C<47,6>LINE = OCT(PDSYM$WORD3[I],8,6);  #LN#
              C<54,6>LINE = OCT(PDSYM$WORD3[I],14,6); #FWA# 
              C<61,20>LINE = OCT(PDSYM$WORD3[I],0,20);
              C<90,6>LINE = DEC(PDSYM$LN[I]); 
              CBLIST(LISTCTL"LINE",LINE,100) ;
              END 
  
          RETURN; 
          END 
CONTROL EJECT;
 # * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * #
 #                                                                     #
 #    DDSYMDMP - DATA DIVISION SYMBOL TABLE DUMP                       #
 #                                                                     #
 #    GIVEN - SIZE OF TABLE                                            #
 #                                                                     #
 #    DOES - DUMPS CURRENT CONTENTS OF DD$SYM$TBL W/ DDSYM$HDR         #
 #                                                                     #
 # * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * #
          PROC  DDSYMDMP(SIZE); 
  
          BEGIN 
  
          ITEM  DDTITLE      C(100) = "HEADER WORD OCTAL    NAME  WC  LO
RD     DPC SAVEA1 / DEC -  WC  LORD -- DD SYMBOL TABLE DUMP        "; 
          ITEM  DDDESTITLE1  C(100) = "            NAME               U 
Q     D                    S L S     SI J B         B                "; 
          ITEM  DDDESTITLE2  C(100) = "                               N 
L     D                    G E E     UN S W         C                "; 
          ITEM  DDDESTITLE3  C(100) = "                               Q 
F LEV S  TYP OCCURS OCCDEP N D P RB  BD T Z DPP LEN P     RA         "; 
          ITEM  C20          C(20); 
          ITEM  SIZE         I; 
  
          ARRAY[20] S(1); 
              ITEM TYPETABLE C(0,0,10) = [
                    "0",  "AL", "ALE",  "AN", "ANE",
                  "ERR",  "NE", "NUM", "EXF",  "C4",
                   "C2", "DC2",  "C1",  "LC", "IDD",
                  "IDX",  "GR", "VGR", "NON", "BIT",
                  "BDS" ];
  
          ARRAY [17] S(1);
  
              ITEM LEVELTABLE C(0,0,10) = [ 
                  "CDN",  "FD",  "SD",  "CD",  "RD",
                  "IDX", "MNM", "LIT", "TMP", "RDN",
                  "EDT", "MOD", "FDS", "WSS", "LKS",
                  "CDS",  "66", "RDS"]; 
          LINE = " "; 
          CBLIST(LISTCTL"EJECT"); 
          CBLIST(LISTCTL"SKIPPRINT",DDTITLE,100); 
          C20 = OCT(DDSYM$HDR,0,20);
          C<0,20>LINE = C20;
          C<21,4>LINE = C<0,4>C20;
          C<26,4>LINE = C<4,4>C20;
          C<31,4>LINE = C<8,4>C20;
          IF DDSYM$DPC NQ 0 THEN
              C<41>LINE = "1";
          ELSE
              C<41>LINE = "0";
          C<44,6>LINE = C<14,6>C20;    # SAVEA1                        #
          C<59,4>LINE = DEC(DDSYM$WC);
          C<64,4>LINE = DEC(DDSYM$LORD);
          CBLIST(LISTCTL"SKIPPRINT",LINE,70); 
          CBLIST(LISTCTL"SKIPPRINT",DDDESTITLE1,100); 
          CBLIST(LISTCTL"LINE",DDDESTITLE2,100);
          CBLIST(LISTCTL"LINE",DDDESTITLE3,100);
          LINE = " "; 
          CBLIST(LISTCTL"LINE",LINE,10);
          FOR I = 1 STEP 1 UNTIL SIZE DO
              BEGIN 
              C<0,30>LINE = DDSYM$NAME[I];
              LAST = 0; 
              FOR LAST=LAST WHILE C<LAST>LINE NQ O"00" AND LAST LS 30 
              DO
                  LAST = LAST + 1;
              IF LAST NQ 30 THEN
              C<LAST,30-LAST>LINE = " ";
              IF DDSYM$UNQ[I] EQ UNQ"UNIQUE" THEN C<31>LINE = "U";
              ELSE IF DDSYM$UNQ[I] EQ UNQ"LAST" THEN C<31>LINE = "L"; 
              ELSE IF DDSYM$UNQ[I] EQ UNQ"INBETWEEN" THEN C<31>LINE="B";
              ELSE C<31>LINE = "F"; 
              IF DDSYM$QLF[I] EQ 0
              THEN  C<33>LINE = "0";
              ELSE  C<33>LINE = "1";
              TEMP = DDSYM$LEVEL[I];
              IF TEMP GR 49 AND TEMP LS 68 THEN 
                  C<36,3>LINE = LEVELTABLE[TEMP-50];
              ELSE
                  C<36,3>LINE = DEC(TEMP);
              C<39,2>LINE = DEC(DDSYM$DDS[I]);
              TEMP = DDSYM$TYPE[I]; 
              IF TEMP LS 21 THEN
                  C<42,3>LINE = TYPETABLE[TEMP];
              ELSE
                  C<42,3>LINE = DEC(TEMP);
              C<46,6>LINE = DEC(DDSYM$OCCURS[I]); 
              C<53,6>LINE = DEC(DDSYM$OCCDEP[I]); 
              IF DDSYM$SGN[I] EQ 0
              THEN C<60>LINE = "0"; 
              ELSE C<60>LINE = "1"; 
              IF DDSYM$LED[I] EQ 0
              THEN C<62>LINE = "0"; 
              ELSE C<62>LINE = "1"; 
              IF DDSYM$SEP[I] EQ 0
              THEN C<64>LINE = "0"; 
              ELSE C<64>LINE = "1"; 
              C<66,3>LINE = OCT(DDSYM$WORD4[I],1,3);  # RB             #
              C<70,2>LINE = DEC(DDSYM$SUBIND[I]); 
              IF DDSYM$JST[I] EQ 0
              THEN C<73>LINE = "0"; 
              ELSE C<73>LINE = "1"; 
              IF DDSYM$BWZ[I] EQ 0
              THEN C<75>LINE = "0"; 
              ELSE C<75>LINE = "1"; 
              C<77,3>LINE = DEC(DDSYM$DPP[I]);
              C<81,3>LINE = DEC(DDSYM$LENGTH[I]); 
              C<85,2>LINE = DEC(DDSYM$BCP[I]);
              C<88,8>LINE = OCT(DDSYM$WORD5[I],12,8);  # RA            #
              CBLIST(LISTCTL"LINE",LINE,100); 
              END 
          RETURN; 
          END 
          $END
 CONTROL EJECT;                                                          ASM2 
          PROC OBJCODEPARM(PARM, ACTION); 
                                                                         ASM2 
 # * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * # ASM2 
 #                                                                     # ASM2 
 #   NAME -      OBJCODEPARM                                           # ASM2 
 #                                                                     # ASM2 
 #   PURPOSE -   TO INSERT THE VALUE OF A PSEUDO-INSTRUCTION PARAMETER # ASM2 
 #                 INTO THE CURRENT PICTURE OF THE INSTRUCTION         # ASM2 
 #                                                                     # ASM2 
 #   GIVEN -     *PARM* = INSERTION VALUE, RIGHT-JUSTIFIED             # ASM2 
 #               *ACTION* = TYPE OF INSERTION                          # ASM2 
 #                   - NO INSERTION                                    # ASM2 
 #                 I - INSERT LOWER 3 BITS INTO BITS 6-8               # ASM2 
 #                 J - INSERT LOWER 3 BITS INTO BITS 9-11              # ASM2 
 #                 K - INSERT LOWER 3 BITS INTO BITS 12-14             # ASM2 
 #                 JK - INSERT LOWER 6 BITS INTO BITS 9-14             # ASM2 
 #                 Q - INSERT LOWER 18 BITS INTO BITS 12-29            # ASM2 
 #                                                                     # ASM2 
 #   DOES -      INSERTS VALUE OF PARAMETER AS INDICATED               # ASM2 
 #               FOR RELOCATABLE PARAMETERS, MODIFIES LOADER TABLES    #
 #                                                                     # ASM2 
 # * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * # ASM2 
                                                                         ASM2 
                                                                         ASM2 
          BEGIN                                                          ASM2 
                                                                         ASM2 
          ITEM  PARM         I;                                          ASM2 
          ITEM  ACTION       I;                                          ASM2 
                                                                         ASM2 
          SWITCH  OBJCODESW  OBJCODE$    ,                               ASM2 
                             OBJCODE$I   ,                               ASM2 
                             OBJCODE$J   ,                               ASM2 
                             OBJCODE$K   ,                               ASM2 
                             OBJCODE$JK  ,                               ASM2 
                             OBJCODE$Q   ;                               ASM2 
                                                                         ASM2 
                                                                         ASM2 
          GOTO OBJCODESW[ACTION];                                        ASM2 
                                                                         ASM2 
 OBJCODE$:                                                               ASM2 
          RETURN;                                                        ASM2 
                                                                         ASM2 
 OBJCODE$I:                                                              ASM2 
          B<6,3>CODEWORD = B<6,3>CODEWORD + B<57,3>PARM;                 ASM2 
          RETURN;                                                        ASM2 
                                                                         ASM2 
 OBJCODE$J:                                                              ASM2 
          B<9,3>CODEWORD = B<9,3>CODEWORD + B<57,3>PARM;                 ASM2 
          RETURN;                                                        ASM2 
                                                                         ASM2 
 OBJCODE$K:                                                              ASM2 
          B<12,3>CODEWORD = B<12,3>CODEWORD + B<57,3>PARM;               ASM2 
          RETURN;                                                        ASM2 
                                                                         ASM2 
 OBJCODE$JK:                                                             ASM2 
          B<9,6>CODEWORD = B<9,6>CODEWORD + B<54,6>PARM;                 ASM2 
          RETURN;                                                        ASM2 
                                                                         ASM2 
 OBJCODE$Q:                                                              ASM2 
          B<12,18>CODEWORD = B<12,18>CODEWORD + B<42,18>PARM;            ASM2 
          IF (REL - 2) GR COMCOUNT THEN 
              BEGIN 
              ASM2ABORT(25);
              REL = 0;
              END 
          IF REL EQ 1  THEN 
              BEGIN 
              CODELENGTH = 30;          # SET DEMAND FOR *FIXLOCATION* #
              FIXLOCATION;
              COUNT = 4*TEXTWC - 4 + POSITION/15; 
              B<COUNT,2>TEXTTBLWD[1] = 2; 
              END 
  
          IF REL GQ 2  THEN 
              BEGIN 
              FILL$NAME[0] = O"4200"; 
              FILL$WC[0] = 1;                    # WORD COUNT          #
              FILL$CR[0] = 0;                    # CONDITIONAL LOAD    #
              FILL$HEADER[0] = 0;                # NOTE HEADER         #
              FILL$BR[0] = REL;                  # WHICH COMMON BLOCK  #
              FILL$TRAILER[0] = 1;               # NOTE TRAILER        #
              FILL$P[0] = (30-POSITION)/15;      # WHICH PARCEL TO FILL#
              FILL$R[0] = USEBLOCK[USEBLK];      # BLOCK WITH WORD     #
              FILL$A[0] = LOCATION;              # LOC. WITHIN ' BLOCK #
              PUTBIN(LOC(FILLTBL[0]), 2);        # WRITE OUT TABLE     #
              END 
          RETURN;                                                        ASM2 
                                                                         ASM2 
          END  #OBJCODEPARM#                                             ASM2 
 CONTROL EJECT; 
          PROC  OBJBDP; 
  
#**       OBJBDP -  GENERATE CODE FOR BDP INSTRUCTIONS
* 
*      OTEXT: 
*         12/OPCODE, 16/(X0), 16/(A0), 16/LEN 
*         12/BCP1, 18/CONST1, 4/MOD1, 8/TABLE1, 18/INDEX1 
*         12/BCP2, 18/CONST2, 4/MOD2, 8/TABLE2, 18/INDEX2 
* 
*      INSTRUCTION= 
*         VFD 9/46XB  (EXCEPT FOR MD$), 
*         VFD 3/B<53,55>LEN,
*         VFD 18/ADDR1, 
*         VFD 4/B<56,4>LEN, 
*         VFD 4/BCP1, 
*         VFD 4/BCP2, 
*         VFD 18/ADDR2
# 
  
          BEGIN 
  
          ITEM  ADDR         I;        # OFFSET PART OF ADDRESS FIELD  #
          ITEM  ADDR1        I;        # ADDRESS OF FIRST PARAMETER    #
          ITEM  BCP1         I;        # BCP OF FIRST PARAMETER        #
          ITEM  LEN          I;        # LENGTH OF OPERATION           #
          ITEM  RELCHAR1     I;        # RELCHAR FOR FIRST PARAMETER   #
          ITEM  REL1         I;        # RELOCATION BLOCK FOR PARM 1   #
          ITEM  I            I;        #LOOP INDEX                     #
  
  
          LEN = B<44,16>INSTR;
          READINS(INSTR,EOF); 
          $BEGIN
          IF EOF THEN ASM2ABORT(15);
          $END
#      POSITION WILL BE 0 HERE,  SO EXTERNAL ADDRESS WILL WORK BELOW   #
          REL = 0;
          RELCHAR = O"55";   #BLANK#
          TABLELOOKUP(ADDR1); 
          IF  LISTO OR COMPASS  THEN
              BEGIN 
              FOR I = 1 STEP 1 UNTIL 14  DO 
                  ASMLINEWD[I] = "          ";
              ASMLINEWD[5] = " #ADDR1   ";
              ASMLINEWD[6] = "SET       ";
              ASMLINEWD[11] = LINENUM;
              LISTOCTAL(ADDR1, 3, 6); 
              IF BLOCKNAME EQ 0 AND COMMENT30 EQ "          " 
              THEN
                  BEGIN 
                  LISTOCTAL(ADDR1, 58,6); 
                  SETCHAR (64,O"2");
                  END 
              ELSE
                  PUTADDR(58);
              IF  LISTO  THEN 
                  CBLIST(1,ASMLINE, 136); 
              IF  COMPASS  THEN 
                  WRITECOMPASS; 
              END 
          REL1 = REL; 
          RELCHAR1 = RELCHAR; 
          BCP1 = B<0,12>INSTR;
  
          READINS(INSTR,EOF); 
          $BEGIN
          IF EOF THEN ASM2ABORT(16);
          $END
#      SET POSITION IN CASE OF EXTERNAL ADDRESS                        #
          POSITION = 30;
          REL = 0;
          RELCHAR = O"55";   #BLANK#
          TABLELOOKUP(ADDR);
          IF  LISTO OR COMPASS  THEN
              BEGIN 
              FOR I = 1 STEP 1 UNTIL 14 DO
                 ASMLINEWD[I] = "          "; 
              ASMLINEWD[5] = " #ADDR2   ";
             ASMLINEWD[6] = "SET       "; 
              ASMLINEWD[11] = LINENUM;
              LISTOCTAL(ADDR, 3, 6);
              IF BLOCKNAME EQ 0 AND COMMENT30 EQ "          " 
              THEN
                  BEGIN 
                  LISTOCTAL (ADDR, 58, 6);
                  SETCHAR (64, O"2"); 
                  END 
              ELSE
                  PUTADDR (58); 
              IF  LISTO  THEN 
                  CBLIST(1,ASMLINE, 136); 
              IF  COMPASS  THEN 
                  WRITECOMPASS; 
              END 
  
          B<0,30>CODEWORD = OBJPICTURE[OPCODE]; 
          B<3,9>CODEWORD = B<3,9>CODEWORD + B<47,9>LEN; 
          B<12,18>CODEWORD = ADDR1; 
          B<30,4>CODEWORD = B<56,4>LEN; 
          B<34,4>CODEWORD = BCP1; 
          B<38,4>CODEWORD = B<8,4>INSTR;
          B<42,18>CODEWORD = ADDR;
  
          POSITION = 0; 
          CODELENGTH = 60;
          FIXLOCATION;
          TEXTTBLWD[TEXTWC+1] = CODEWORD; 
  
          I = LEN;                 #SAVE LEN AROUND USE HERE# 
          COUNT = 4*TEXTWC - 4; 
          IF REL1 EQ 1  THEN
              B<COUNT,2>TEXTTBLWD[1] = 2; 
          IF REL1 GQ 2  THEN
              BEGIN 
              FILL$NAME[0] = O"4200"; 
              FILL$WC[0] = 1;                    # WORD COUNT          #
              FILL$CR[0] = 0;                    # CONDITIONAL LOAD    #
              FILL$HEADER[0] = 0;                # NOTE HEADER         #
              FILL$BR[0] = REL1;                 # WHICH COMMON BLOCK  #
              FILL$TRAILER[0] = 1;               # NOTE TRAILER        #
              FILL$P[0] = 2;                     # FILL UPPER PARCEL   #
              FILL$R[0] = USEBLOCK[USEBLK];      # BLOCK WITH WORD     #
              FILL$A[0] = LOCATION;              # LOC. WITHIN ' BLOCK #
              PUTBIN(LOC(FILLTBL[0]), 2);        # WRITE OUT TABLE     #
              END 
  
          IF REL EQ 1  THEN 
          B<COUNT+2,2>TEXTTBLWD[1] = 2; 
          IF REL GQ 2  THEN 
              BEGIN 
              FILL$NAME[0] = O"4200"; 
              FILL$WC[0] = 1;                    # WORD COUNT          #
              FILL$CR[0] = 0;                    # CONDITIONAL LOAD    #
              FILL$HEADER[0] = 0;                # NOTE HEADER         #
              FILL$BR[0] = REL;                  # WHICH COMMON BLOCK  #
              FILL$TRAILER[0] = 1;               # NOTE TRAILER        #
              FILL$P[0] = 0;                     # FILL LOWER PARCEL   #
              FILL$R[0] = USEBLOCK[USEBLK];      # BLOCK WITH WORD     #
              FILL$A[0] = LOCATION;              # LOC. WITHIN ' BLOCK #
              PUTBIN(LOC(FILLTBL[0]), 2);        # WRITE OUT TABLE     #
              END 
  
          IF LISTO OR COMPASS  THEN 
              BEGIN 
              SETASMLINE; 
              LISTOCTAL(LOCATION, 3, 6);
              LISTOCTAL(CODEWORD, 11, 20);
              SETCHAR(32, RELCHAR1);
              SETCHAR(33, RELCHAR); 
              LEN = I;             #RESTORE LEN (AKA "COUNT")#
              LISTOCTAL(LEN, 58, 5);
              SETCHAR(72, O"33"+BCP1);
              SETCHAR(81, O"33"+B<8,4>INSTR); 
              END 
  
          LOCATION = LOCATION + 1;
          TEXTWC = TEXTWC + 1;
  
          END  #OBJBDP# 
 CONTROL EJECT; 
          PROC  OBJBSS; 
 # * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * #
 #                                                                     #
 #   NAME -  OBJBSS                                                    #
 #                                                                     #
 #   DOES -      HANDLES THE *BSS*                                     #
 #                                                                     #
 # * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * #
  
          BEGIN 
  
          PARM3 = B<42,18>INSTR;
          IF LISTO OR COMPASS  THEN 
              SETASMLINE; 
  
          IF POSITION NQ 0  THEN
              BEGIN 
              LOCATION = LOCATION + 1;
              POSITION = 0; 
              END 
  
          IF LISTO OR COMPASS  THEN 
              BEGIN 
              LISTOCTAL(LOCATION, 3, 6);
              LISTOCTAL(PARM3, 34, 6);
              END 
  
              IF  TEXTWC NQ 1  THEN  #NONEMPTY# 
              PUTBIN(LOC(TEXTTBL), TEXTWC+1); 
              LOCATION = LOCATION + PARM3;
              TEXTWC = 1; 
              TEXTTBLWD[1] = 0; 
              TEXTR = USEBLOCK[USEBLK]; 
              TEXTTBLWD[2] = 0; 
              TEXTS = LOCATION; 
  
          END  #OBJBSS# 
 CONTROL EJECT;                                                          ASM2 
          PROC  OBJCODE;                                                 ASM2 
                                                                         ASM2 
 # * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * # ASM2 
 #                                                                     # ASM2 
 #   NAME -      OBJCODE                                               # ASM2 
 #                                                                     # ASM2 
 #   PURPOSE -   TO GENERATE LOADER TEXT FOR *CODE*-TYPE INSTRUCTIONS  # ASM2 
 #               TO OPTIONALLY LIST OCTAL CODE ON *ASMLINE*            # ASM2 
 #                                                                     # ASM2 
 #   GIVEN -     *OPCODE*                                              # ASM2 
 #               *PARM1*, *PARM2*, *PARM3*                             # ASM2 
 #                                                                     # ASM2 
 #   DOES -                                                            # ASM2 
 #                                                                     # ASM2 
 # * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * # ASM2 
                                                                         ASM2 
                                                                         ASM2 
          BEGIN                                                          ASM2 
  
          EXTRACTPARMS; 
          IF LISTO OR COMPASS  THEN 
              SETASMLINE; 
                                                                         ASM2 
          CODEWORD = OBJPICTURE[OPCODE]*2**30;
          CODELENGTH = OBJLENGTH[OPCODE];                                ASM2 
                                                                         ASM2 
          OBJCODEPARM(PARM1, OBJACTPARM1[OPCODE]);
          OBJCODEPARM(PARM2, OBJACTPARM2[OPCODE]);
          OBJCODEPARM(PARM3, OBJACTPARM3[OPCODE]);
          IF  LISTLINE
          THEN
              BEGIN 
              SETCHAR(22 + (POSITION+2)/3, RELCHAR);
                                                                         ASM2 
              IF  POSITION EQ 0  THEN  LISTOCTAL(LOCATION,3,6); 
              LISTOCTAL( RSHIFT(CODEWORD, 60-CODELENGTH),                ASM2 
                         11 + (POSITION+2)/3, 
                         (CODELENGTH+2)/3 );
              END 
  
          CODEWORD = RSHIFT(CODEWORD, POSITION-60); 
  
          FIXLOCATION;
          TEXTTBLWD[TEXTWC+1] = TEXTTBLWD[TEXTWC+1] + CODEWORD; 
                                                                         ASM2 
          POSITION = POSITION + CODELENGTH;                              ASM2 
          IF POSITION EQ 60   THEN
              BEGIN 
              POSITION = 0; 
              LOCATION = LOCATION + 1;
              TEXTWC = TEXTWC + 1;
              END 
          $BEGIN
          IF POSITION GR 60  THEN ASM2ABORT(1); 
          $END
                                                                         ASM2 
                                                                         ASM2 
                                                                         ASM2 
          RETURN;                                                        ASM2 
                                                                         ASM2 
          END  #OBJCODE#                                                 ASM2 
 CONTROL EJECT; 
          PROC   OBJDATA; 
 # * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * #
 #                                                                     #
 #    NAME -     OBJDATA                                               #
 #                                                                     #
 #    PURPOSE -  TO GENERATE LOADER TEXT FOR DATA WORDS                #
 #                                                                     #
 #    GIVEN -    ASMLINE SET UP WITH *DATA* IN COLS 51-54              #
 #                                                                     #
 # * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * #
  
          BEGIN 
  
          PARM2 = B<28,14>INSTR;
          IF LISTO OR COMPASS  THEN 
              SETASMLINE; 
  
          IF POSITION NQ 0  THEN
              BEGIN 
              LOCATION = LOCATION + 1;
              POSITION = 0; 
              END 
  
          CODELENGTH = 60;             # SET DEMAND FOR *FIXLOCATION*  #
  
          FOR COUNT = 1 STEP 1 UNTIL PARM2 DO 
              BEGIN 
              READINS(INSTR, EOF);
              IF EOF  THEN ASM2ABORT(2);
              FIXLOCATION;
              TEXTTBLWD[TEXTWC+1] = INSTR;
              TEXTWC = TEXTWC + 1;
              IF LISTO OR COMPASS  THEN 
                  BEGIN 
                  LISTOCTAL(LOCATION,3,6);
                  LISTOCTAL(INSTR,11,20); 
                  LISTOCTAL(INSTR,58,20); 
                  SETCHAR(78,O"02");   #B#
                  IF LISTO  THEN
                      CBLIST(1, ASMLINE, 136);
                  IF COMPASS  THEN
                      WRITECOMPASS; 
                  END 
              LOCATION = LOCATION + 1;
              END 
  
          LISTLINE = FALSE; 
  
          END  #OBJDATA#
CONTROL EJECT;
          PROC  OBJEND$;
  
#**       OBJEND$ -  PROCESS END OF BINARY DECK 
* 
*         OBJEND
* 
* 
*         FLUSHES OUT ALL TEXT TABLES.
*         WRITES END OF RECORD ON THE BINARY FILE (E.G. *LGO*). 
# 
  
          BEGIN 
          ITEM  TRANSFERADDR I;        # TRANSFER ADDRESS              #
  
  
          IF  TEXTWC GR 1 OR POSITION NQ 0
          THEN
              PUTBIN(LOC(TEXTTBL), TEXTWC+1); 
 #                                                                     #
 #             FLUSH OUT EACH USE BLOCK WITH PARTIAL WORD LEFT         #
 #                                                                     #
          FOR  USEBLK = 1  STEP 1  UNTIL BLOCKCNT  DO 
              BEGIN 
              IF  USEPOS[USEBLK] NQ 0 THEN
                  BEGIN 
                  TEXTWC = 2; 
                  TEXTTBLWD[1] = 0; 
                  B<0,3>TEXTTBLWD[1] = USEPARTRELS[USEBLK]; 
                  TEXTTBLWD[2] = USEPARTWD[USEBLK]; 
                  TEXTS = USEORG[USEBLK]; 
                  TEXTR = USEBLOCK[USEBLK]; 
                  PUTBIN(LOC(TEXTTBL),3); 
                  END 
              END 
  
  
          LINKTABLE;         #PUT OUT LINK TABLES                      #
#      WRITE OUT *ENTR* TABLE INDICATING ADDRESS OF ENTRY POINT        #
  
          TEXTTYPE = O"3600";                    # *ENTR* TABLE        #
          TEXTWC = 2; 
          TEXTTBLWD[1] = IDENTNAME; 
          REL = 0;
          RELCHAR = CHAR$BLANK; 
          TABLELOOKUP(TRANSFERADDR);             # GET ADDRESS         #
          TEXTTBLWD[2] = 0; 
          B<33,9>TEXTTBLWD[2] = REL;             # LOADER BLK. NO.     #
          B<42,18>TEXTTBLWD[2] = TRANSFERADDR;   # ADDRESS             #
          PUTBIN(LOC(TEXTTBL), 3);               # WRITE OUT TABLE     #
  
          IF LISTO OR COMPASS  THEN 
              BEGIN 
              IF  LISTO AND LISTLINE  THEN
                  CBLIST(1, ASMLINE, 136);
              IF  COMPASS AND LISTLINE  THEN
                  WRITECOMPASS; 
              BLOCKNAME = 0;
              SETASMLINE; 
              LEN = LENLJZF(IDENTNAME); 
              C<0,10>TEMP = "          "; 
              C<0,LEN>TEMP = C<0,LEN>IDENTNAME; 
              C<7,3>ASMLINEWD[6] = C<0,3>TEMP;
              C<0,7>ASMLINEWD[7] = C<3,7>TEMP;
              LISTOCTAL(TRANSFERADDR, 33, 6); 
              SETCHAR(40, RELCHAR); 
              END 
  
 #    WRITE LINE NUMBER AND SYMBOL TABLES IF INTERACTIVE DEBUGGING     #
          IF CCTIDBUG[0] THEN IDTABLES; 
  
 #                                                                     #
 #             DECLARE THE ENTRY POINT                                 #
 #                                                                     #
          IF NOT CCTSUBPROGR[0] THEN
              BEGIN 
              TEXTTYPE = O"4600"; 
              TEXTWC = 1; 
              TEXTTBLWD[1] = IDENTNAME; 
              PUTBIN(LOC(TEXTTBL), 2);
              END 
  
          TMRTNTB(TABLETYPE"WORK3$"); 
#      WRITE END-OF-RECORD ON THE BINARY FILE                          #
  
          PUTWEOR;
                                                                         ASM2 
          END  #OBJEND$#
 CONTROL EJECT; 
          PROC  OBJIM;
  
#**       OBJIM -  PROCESS THE INDIRECT MOVE BDP INSTRUCTION
* 
*      OTEXT: 
*         VFD 12/OPCODE, 16/X0, 16/REGJ, 16/0 
*         VFD 12/(UNUSED), 18/OFFSET, 4/MOD, 8/TABLE, 18/INDEX
* 
*      INSTRUCTION= 
*         VFD 9/464B, 3/REGJ, 18/ADDRESS
# 
  
          BEGIN 
  
          ITEM  ADDR         I;        # OFFSET PART OF ADDRESS FIELD  #
  
  
          CODEWORD = O"00000000004640000000"; 
          PARM2 = B<41,3>INSTR;        # SAVE B-REGISTER FOR LISTING   #
          B<39,3>CODEWORD = PARM2;
          READINS(INSTR,EOF); 
          $BEGIN
          IF EOF THEN  ASM2ABORT(17); 
          $END
          CODELENGTH = 30;
          FIXLOCATION;
#       POSITION IS OK HERE SO EXTERNAL ADDRESS WILL WORK BELOW        #
          REL = 0;
          RELCHAR = O"55";   #BLANK#
          TABLELOOKUP(ADDR);
          B<42,18>CODEWORD = B<42,18>ADDR;
          B<POSITION,30>TEXTTBLWD[TEXTWC+1] = CODEWORD; 
  
          IF REL EQ 1  THEN 
              BEGIN 
              COUNT = 4*TEXTWC - 4 + POSITION/15; 
              B<COUNT,2>TEXTTBLWD[1] = 2; 
              END 
  
          IF LISTO OR COMPASS  THEN 
              BEGIN 
              SETASMLINE; 
              LISTOCTAL(LOCATION, 3, 6);
              LISTOCTAL(CODEWORD, 11, 20);
              SETCHAR(32, RELCHAR); 
              LISTOCTAL(PARM2, 59, 1);
              END 
  
          $BEGIN
          IF POSITION NQ 0  THEN
              ASM2ABORT(1); 
          $END
          LOCATION = LOCATION + 1;
          TEXTWC = TEXTWC + 1;
  
          END  #OBJIM#
 CONTROL EJECT; 
          PROC  OBJIDENT; 
  
#**       OBJIDENT -  HANDLE *IDENT* PSEUDO-OP
* 
*         OBJIDENT
* 
* 
*         IF LISTING,  PRINT LINE.
# 
  
          BEGIN 
  
#      CONSTRUCT THE PROPER IDENT NAME FOR THIS SEGMENT                #
  
      IF B<42,18>INSTR EQ 0  THEN 
          BEGIN 
          FOR COUNT = 1 STEP 1 UNTIL 6 DO 
              BEGIN 
              IF C<COUNT,1>CCTPROGRAMID[0] EQ " "  THEN 
                  GOTO OBJIDENT1; 
              END 
          COUNT = 7;
 OBJIDENT1: 
          IDENTNAME = 0;
          C<0,COUNT>IDENTNAME = C<0,COUNT>CCTPROGRAMID[0];
          END 
      ELSE
          BEGIN 
          IF B<42,18>INSTR EQ 100  THEN 
              B<42,18>INSTR = 0;
          COUNT = 5;
          IF C<4,1>CCTPROGRAMID[0] EQ " "  THEN 
              COUNT = 4;
          IF C<3,1>CCTPROGRAMID[0] EQ " "  THEN 
              COUNT = 3;
          IF C<2,1>CCTPROGRAMID[0] EQ " "  THEN 
              COUNT = 2;
          IF C<1,1>CCTPROGRAMID[0] EQ " "  THEN 
              COUNT = 1;
          IDENTNAME = 0;
          C<0,COUNT>IDENTNAME = C<0,COUNT>CCTPROGRAMID[0];
  
          C<0,10>TEMP = DEC(B<42,18>INSTR);      # SEGMENT NUMBER      #
          IF B<6,6>TEMP EQ CHAR$BLANK  THEN 
              BEGIN 
              B<6,6>TEMP = B<0,6>TEMP;
              B<0,6>TEMP = CHAR$ZERO; 
              END 
          C<COUNT,2>IDENTNAME = C<0,2>TEMP; 
          END 
  
          IF LISTO OR COMPASS  THEN 
              BEGIN 
              C<0,10>TEMP = "          "; 
              LEN = LENLJZF(IDENTNAME); 
              C<0,LEN>TEMP = C<0,LEN>IDENTNAME; 
              IF COMPASS  THEN
                  BEGIN 
                  C<0,6>COMPASSLINEW[5] = "*DECK "; 
                  C<6,4>COMPASSLINEW[5] = C<0,4>TEMP; 
                  C<0,10>COMPASSLINEW[6] = "          ";
                  C<0,3>COMPASSLINEW[6] = C<4,3>TEMP; 
                  PUTSQ(UPTR, LOC(COMPASSLINE), 14);
                  END 
              COMMENT30 = "          "; 
              SETASMLINE; 
              C<7,3>ASMLINEWD[6] = C<0,3>TEMP;
              C<0,7>ASMLINEWD[7] = C<3,7>TEMP;
              END 
  
          PRFXNAM = IDENTNAME;
          PUTPRFX(CCTSSDNATPTR);       # WRITE OUT PREFIX TABLE        #
  
          PUTLDST;   #  OUTPUT LDSET TABLE #
  
 #                                                                     #
 #   SET USE BLOCK NUMBERS FOR LOADER                                  #
 #                                                                     #
          COUNT = 3;            # LOADER NUMBER FOR FIRST COMMON BLOCK #
          CODELENGTH = 0;                    # LENGTH OF PROGRAM BLOCK #
          USEBEG$CODE = O"444444";    # (SO IF NO *CODE* BLOCK, ERROR) #
          USEBEG$ATEMP = O"555555";  # (SO IF NO *ATEMP* BLOCK, ERROR) #
          USEBEG$SBTMP = USESTART[SBTMPBLK];
          FOR USEBLK = 1  STEP 1  UNTIL  BLOCKCNT  DO 
              BEGIN 
              USELABEL[USEBLK] = FALSE; 
  
              USEPOS[USEBLK] = 0; 
              USEORG[USEBLK] = USESTART[USEBLK];
              USEPARTRELS[USEBLK] = 0;
              IF GLOBAL[USEBLK]  THEN 
                  BEGIN 
                  USEBLOCK[USEBLK] = COUNT; 
                  COUNT = COUNT + 1;
                  END 
              ELSE
                  BEGIN 
                  USEBLOCK[USEBLK] = 1; 
                  CODELENGTH = CODELENGTH + USELENGTH[USEBLK];
                  IF USENAME[USEBLK] EQ "CODE"  THEN
                      USEBEG$CODE = USESTART[USEBLK]; 
          IF  USENAME[USEBLK] EQ "ATEMPS"  THEN 
                      USEBEG$ATEMP = USESTART[USEBLK];
                  END 
              END 
  
 #                                                                     #
 #   WRITE OUT *PIDL* TABLE                                            #
 #                                                                     #
          B<0,12>TEMP = O"3400";
          B<12,12>TEMP = COUNT - 2; 
          PUTBIN(LOC(TEMP), 1); 
          C<0,7>CODELENGTH = C<0,7>IDENTNAME; 
          PUTBIN(LOC(CODELENGTH), 1); 
          FOR USEBLK = 1  STEP 1  UNTIL  BLOCKCNT  DO 
              BEGIN 
              IF GLOBAL[USEBLK]  THEN 
                  BEGIN 
                  COMCOUNT = COMCOUNT + 1;
                  IF C<0,6>USENAME[USEBLK] NQ "SSECTN"
                  THEN
                      PUTBIN(LOC(USEWORD1[USEBLK]),1);
                  ELSE
                      BEGIN 
                      C<0,7>TEMP = USENAME[USEBLK]; 
                      B<42,18>TEMP = (USELENGTH[USEBLK]+7)/8
                                                 + O"400000"; 
                      PUTBIN(LOC(TEMP),1);
                      END 
                  END 
              END 
  
          USEBLK = 1;            # ARBITRARILY ASSUME INTERNAL BLOCK 1 #
          POSITION = 0; 
          LOCATION = USEORG[USEBLK];
  
          TEXTTYPE = O"4000";          # INITIALIZE TEXT TABLE         #
          TEXTWC = 1;                  # WORD COUNT = 1 FOR REL. BITS  #
          TEXTTBLWD[1] = 0;            # RELOCATION BITS               #
          TEXTR = 1;                   # BLOCK = PROGRAM RELOCATABLE   #
          TEXTC = 0;                   # LOAD TEXT UNCONDITIONALLY     #
          TEXTS = LOCATION; 
 #                                                                     #
 #   SET UP *XFILL* TABLE                                              #
 #                                                                     #
          XFILL$NAME[0] = O"4100";
          XFILL$WC[0] = 1;
          XFILL$CR[0] = 0;
  
 #    SET UP LINE NUMBER TABLE FOR INTERACTIVE DEBUGGER                #
  
          IF CCTIDBUG[0] THEN 
              BEGIN 
              IF GROUP1FLAG EQ 0 THEN 
              GROUP1FLAG = CMM$AGR(1);
  
              TEMP=CMM$ALV(MAXLNTBLSIZE*LNTBLENTRYSZ,1,3,GROUP1FLAG,
                                                       P<LINENO$TBL>,0);
              FOR I = 1 STEP 1 UNTIL MAXLNTBLSIZE DO
                  LINENO$WORD[I] = 0; 
              LINENO$NAME[1] = LINETBLNAME; 
              LINENO$LORD[1] = LORD;
              LNWC = 1; 
              CURLNTBLHDR = 1;  # CURRENT LINE NO TABLE HEADER LOCATION#
              CURLNARYSIZE = MAXLNTBLSIZE;
              ID$LN$PN = 0; 
              END 
                                                                         ASM2 
          END  #OBJIDENT# 
          CONTROL EJECT;
          PROC  OBJLABEL; 
 # * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * #
 #                                                                     #
 #     OBJLABEL -  HANDLE LISTING OF LABEL$                            #
 #                                                                     #
 # * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * #
  
          BEGIN 
          IF LISTO OR COMPASS  THEN 
              BEGIN 
              MINUS$FLAG = 0; 
              SETASMLINE; 
          TEMP = B<34,8>INSTR;
          IF  TEMP EQ TABLETYPE"LOCAL$" THEN
                  C<1,1>ASMLINEWD[5] = "L"; 
              ELSE
                  C<1,1>ASMLINEWD[5] = "P"; 
              TEMP = B<42,18>INSTR; 
              LISTOCTAL(TEMP,43,6); 
              LISTOCTAL(LOCATION,3,6);
              END 
          IF CCTIDBUG[0] THEN 
              BEGIN 
              TEMP = B<34,8>INSTR;
              IF TEMP EQ TABLETYPE"PNAT$" AND 
                 B<42,18>INSTR LQ PNTLEN
              THEN   # INDICATE PARAGRAPH NAME IN LINE NUMBER TABLE    #
                  ID$LN$PN = B<42,18>INSTR; 
              END 
          END  #OBJLABEL# 
 CONTROL EJECT; 
          PROC  OBJLINE;
 # * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * #
 #                                                                     #
 #     OBJLINE - SAVES LINE NUMBER FOR LISTING PURPOSES                #
 #                                                                     #
 #     GIVEN -   PARM3 = BINARY LINE NUMBER                            #
 #                                                                     #
 #     DOES-     SETS LINENUM = CHARACTER LINE NUMBER, R.J.Z.F.        #
 #               DOES NOT PRINT THIS LINE                              #
 #                                                                     #
 # * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * #
  
          ITEM  OBJLISTPTR  =  1; 
          ITEM  OBJLISTINDX;
          BEGIN 
  
          PARM3 = B<42,18>INSTR;
  
          $BEGIN
          IF LISTO OR COMPASS  THEN 
              BEGIN 
              IF PARM3 GR BUG203C$HIGH[BUG203C$NGRP]  THEN
                  BEGIN 
                  LISTO = FALSE;
                  END 
              END 
          ELSE
              BEGIN 
              FOR BUG203C$NGRP = 1 STEP 1 UNTIL 10 DO 
                  BEGIN 
                  IF PARM3 GQ BUG203C$LOW[BUG203C$NGRP] 
                  AND PARM3 LQ BUG203C$HIGH[BUG203C$NGRP] 
                  THEN
                      BEGIN 
                      LISTO = TRUE; 
                      GOTO OBJLINE1;     #PRESERVE BUG203C$NGRP#
                      END 
                  END 
              BUG203C$NGRP = 10;       # IF NONE FOUND# 
OBJLINE1: 
              END 
          $END
  
          IF  CCTOBJLSTLEN NQ 0 AND CCTSOURCLIST
          THEN
              BEGIN 
              FOR OBJLISTPTR = CCTOBJLSTLEN STEP -1 UNTIL 1 DO
                  BEGIN 
                  OBJLISTINDX = VIRTUAL(TABLETYPE"OBJLST$",OBJLISTPTR); 
                  IF PARM3 GQ OBJLISTLINE[OBJLISTINDX]
                  THEN
                      BEGIN 
                      LISTO = OBJLISTFLAG[OBJLISTINDX]; 
                      GOTO OBJLINE2;
                      END 
                  END 
              END 
 OBJLINE2:  
          IF LISTO OR COMPASS  THEN 
              SETASMLINE; 
  
          C<0,10>LINENUM = DEC(PARM3);
          LISTLINE = FALSE; 
  
          RA$LINE[0] = PARM3; 
  
          IF CCTIDBUG[0] THEN   # CREATE LINE NUMBER TABLE ENTRY       #
              BEGIN 
              LNWC = LNWC + 1;
              $BEGIN IF LNWC GR CURLNARYSIZE+1 THEN ASM2ABORT(30); $END 
              IF LNWC GR CURLNARYSIZE THEN
                  BEGIN   # ADD A LINE NO. TABLE #
                  CMM$GLV(LINENO$TBL,MAXLNTBLSIZE*LNTBLENTRYSZ);
                  CURLNARYSIZE = CURLNARYSIZE+MAXLNTBLSIZE*LNTBLENTRYSZ;
                  FOR I = LNWC STEP 1 UNTIL CURLNARYSIZE DO 
                      LINENO$WORD[I] = 0; 
                  LINENO$WC[CURLNTBLHDR] =
                                       MAXLNTBLSIZE * LNTBLENTRYSZ - 1; 
                  CURLNTBLHDR = LNWC; 
                  LINENO$NAME[LNWC] = LINETBLNAME;
                  LINENO$LORD[LNWC] = LORD; 
                  LNWC = LNWC + 1;
                  END 
              LINENO$LN[LNWC] = PARM3;
              LINENO$FWA[LNWC] = LOCATION;
              LINENO$PN[LNWC] = ID$LN$PN; 
              ID$LN$PN = 0; 
              END 
  
          END  #OBJLINE#
 CONTROL EJECT; 
          PROC OBJNOTE; 
 # * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * #
 #                                                                     #
 #   OBJNOTE -  GENERATE A COMMENT CARD                                #
 #                                                                     #
 #   INPUT -  WORD 1 = 6/OPCODE,22/0,14/1,18/NOTES FOLLOWING           #
 #            WORD 2 = 60/(CHARACTERS 1 - 10)                          #
 #     THE ABOVE TWO WORDS ARE REPEATED AS MANY TIMES AS THERE ARE     #
 #     NOTE COMMANDS IN THIS GROUP, WITH =NOTES FOLLOWING= DECREMENTED #
 #     EACH TIME.                                                      #
 #     WHEN NO NOTES FOLLOWING REMAIN, THE LINE IS OUTPUT.             #
 #                                                                     #
 # * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * #
  
          BEGIN 
  
          IF LISTO OR COMPASS  THEN 
              SETASMLINE; 
  
          TEMP = B<42,18> INSTR;
          C<0,1> ASMLINEWD [5] = "*"; 
          READINS(INSTR,EOF); 
          IF EOF  THEN ASM2ABORT(3);
              BEGIN 
              C<0,10> ASMLINEWD [11 - TEMP] = C<0,10> INSTR;
              END 
          FOR TEMP = TEMP - 1  STEP - 1  UNTIL 0  DO
              BEGIN 
              READINS (INSTR, EOF); 
              IF EOF  THEN  ASM2ABORT (11); 
              IF B<42,18> INSTR NQ TEMP  THEN  ASM2ABORT (12);
              IF B<0,12> INSTR NQ OPNAMES "NOTED"  THEN  ASM2ABORT (13);
              READINS (INSTR, EOF); 
              IF EOF  THEN  ASM2ABORT (14); 
              IF LISTO OR COMPASS  THEN 
                  C<0,10> ASMLINEWD [11 - TEMP] = C<0,10> INSTR;
          END 
  
          END  #OBJNOTE#
          CONTROL EJECT;
          PROC  OVCAP;
  
 #        OVCAP - WRITE AN OVCAP DIRECTIVE        # 
  
          ITEM  OVCAPDIR C(10) = "OVCAP.    ";
          BEGIN 
          IF LISTO  THEN SETASMLINE;
          B<48,12> OVCAPDIR = 0;
          PUTBIN(LOC(OVCAPDIR),1);
          PUTWEOR;
          RETURN; 
          END 
CONTROL EJECT;
          PROC  OBJOVLY;
  
#**       OBJOVLY -  WRITE OUT AN *OVERLAY* DIRECTIVE.
* 
*         OBJOVLY 
* 
* 
*         WRITES OUT OVERLAY DIRECTIVE. 
*           OVERLAY FILE NAME IS TAKEN FROM CCT.
*           PRIMARY AND SECONDARY LEVELS ARE TAKEN FROM INSTRUCTION.
# 
  
          BEGIN 
  
          ITEM  LCCIMAGE C(40) = "OVERLAY(1234567,PR,SC)        ";
          ITEM  L            I; 
  
  
         TEMP = O"00000000000000000000";
          C<38,2>LCCIMAGE = C<8,2>TEMP; 
          C<30,8>LCCIMAGE = "        "; 
          TEMP = O"03024003170405000000";   #CB5CODE# 
          L = LENLJZF(TEMP);           # ACTUAL LENGTH OF NAME         #
          C<8,7>LCCIMAGE = "       "; 
          C<8,7>LCCIMAGE = C<0,L>TEMP;
          TEMP = O"00000000000000560000"; 
          B<30,6>TEMP = O"33" + B<45,3>INSTR; 
          B<36,6>TEMP = O"33" + B<48,3>INSTR; 
          B<48,6>TEMP = O"33" + B<54,3>INSTR; 
          B<54,6>TEMP = O"33" + B<57,3>INSTR; 
        CURRENT$OVL = B<45,6>INSTR + B<54,6>INSTR;
          IF  CURRENT$OVL EQ 0  THEN
              BEGIN 
              CCTOVCOUNT = CCTOVCOUNT + CCTCAPCOUNT;
              C<21,8>LCCIMAGE = ",OV=   )"; 
              C<0,10>L = DEC(CCTOVCOUNT+1); 
              C<25,3>LCCIMAGE = C<0,3>L;
              END 
        IF B<45,6>INSTR EQ O"77" THEN CURRENT$OVL = CURRENT$OVL - 1;
          C<16,5>LCCIMAGE = C<5,5>TEMP; 
          PUTBIN(LOC(LCCIMAGE),4);
          PUTWEOR;
  
          IF LISTO OR COMPASS  THEN 
              BEGIN 
              FOR TEMP = 1 STEP 1 UNTIL 14 DO 
                  ASMLINEWD[TEMP] = "          "; 
              C<3,7>ASMLINEWD[14] = 0;
              C<0,10>ASMLINEWD[5] = C<0,10>LCCIMAGE;
              C<0,10>ASMLINEWD[6] = C<10,10>LCCIMAGE; 
              C<0,10>ASMLINEWD[7] = C<20,10>LCCIMAGE; 
              LISTLINE = TRUE;
              END 
          IF  CURRENT$OVL EQ 0  THEN
              C<21,7>LCCIMAGE = ")      ";
  
          END  #OBJOVLY#
 CONTROL EJECT; 
          PROC OBJREPL; 
 # * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * #
 #                                                                     #
 #   OBJREPL -  GENERATE A REPL TABLE                                  #
 #                                                                     #
 # * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * #
  
          BEGIN 
  
          ITEM  COPYCOUNT    I; 
          ITEM  COPYLABEL    I; 
          ITEM  COPYLABLTYPE I; 
          ITEM  COPYSIZE     I; 
  
  
          PARM2 = B<28,14>INSTR;
          PARM3 = B<42,18>INSTR;
          IF LISTO OR COMPASS  THEN 
              SETASMLINE; 
  
          IF PARM2 NQ 1  THEN ASM2ABORT(20);
          TEMP = O"43000002000000000000";        # 43 TABLE, WC = 2    #
          PUTBIN(LOC(TEMP), 1);                  # WRITE OUT WORD 0    #
          COPYCOUNT = PARM3;                     # SAVE REPL COUNT     #
          READINS(INSTR, EOF);                   # GET NEXT WORD       #
          IF EOF  THEN ASM2ABORT(21); 
          COPYSIZE = B<0,12>INSTR;               # SAVE SIZE OF BLOCK  #
          COPYLABEL = B<42,18>INSTR;             # SAVE LABEL NUMBER   #
          IF B<36,6>INSTR EQ O"46"  THEN
              COPYLABLTYPE = "L"; 
          ELSE
              COPYLABLTYPE = "P"; 
          TABLELOOKUP(TEMP);                     # SET TEMP = ADDRESS  #
          B<33,9>TEMP = REL;                     # INSERT BASE DESIG.  #
          PUTBIN(LOC(TEMP), 1);                  # WRITE OUT WORD 1    #
          TEMP = 0;                              # CLEAR WORD 2        #
          B<0,18>TEMP = COPYCOUNT;
          B<18,15>TEMP = COPYSIZE;
          PUTBIN(LOC(TEMP), 1);                  # WRITE OUT WORD 2    #
          TEMP = COPYSIZE*COPYCOUNT;             # TOTAL FILLED SPACE  #
  
          IF  POSITION NQ 0  THEN 
              BEGIN 
              POSITION = 0; 
              LOCATION = LOCATION + 1;
              END 
  
          IF LISTO OR COMPASS  THEN 
              BEGIN 
              C<0,10>ASMLINEWD[6] = "REPI   S/L"; 
              C<0,10>ASMLINEWD[7] = "******,C/*"; 
              C<0,10>ASMLINEWD[8] = "***B,B/***"; 
              C<0,2>ASMLINEWD[9] = "*B";
              C<9,1>ASMLINEWD[6] = C<9,1>COPYLABLTYPE;
              LISTOCTAL(COPYLABEL,61,6);
              LISTOCTAL(COPYCOUNT,70,4);
              LISTOCTAL(COPYSIZE,78,4); 
              IF  LISTO  THEN 
                  CBLIST(1, ASMLINE, 136);
              IF  COMPASS  THEN 
                  WRITECOMPASS; 
              FOR  COPYCOUNT = 1 STEP 1 UNTIL 14  DO
                  ASMLINEWD[COPYCOUNT] = "          ";
#     COPYCOUNT WAS USED TO AVOID DEFINING ANOTHER VARIABLE           # 
              C<0,3>ASMLINEWD[6] = "BSS"; 
              LISTOCTAL(LOCATION, 3, 6);
              LISTOCTAL(TEMP, 34, 6); 
              LISTOCTAL(TEMP, 58, 5); 
              C<2,1>ASMLINEWD[7] = "B"; 
              END 
  
          BLOCKNAME = 0;
          LOCATION = LOCATION + TEMP;            # ADD TOTAL AREA      #
  
          PUTBIN(LOC(TEXTTBL), TEXTWC+1);        # FLUSH TEXT TABLE    #
          TEXTWC = 1; 
          TEXTTBLWD[1] = 0; 
          TEXTR = USEBLOCK[USEBLK]; 
          TEXTTBLWD[2] = 0; 
          TEXTS = LOCATION; 
  
          END  #OBJREPL#
 CONTROL EJECT; 
          PROC   OBJUSE;
 # * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * #
 #                                                                     #
 #   NAME -      OBJUSE                                                #
 #                                                                     #
 #   PURPOSE -   POINTS *USEBLK* TO THE NEW USE BLOCK                  #
 #               OPTIONALLY INSERTS USE NAME INTO LIST LINE            #
 #                                                                     #
 # * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * #
  
          BEGIN 
          ITEM   I           I; 
  
  
      IF  LISTO OR COMPASS  THEN
          SETASMLINE; 
  
      IF USEBLK NQ B<42,18>INSTR  THEN
          BEGIN 
  
              USEPOS[USEBLK] = POSITION;
              USEORG[USEBLK] = LOCATION;
          IF POSITION NQ 0  THEN
              BEGIN 
              USEPARTWD[USEBLK] = TEXTTBLWD[TEXTWC+1];
              TEMP = (TEXTWC - 1)*4;
              USEPARTRELS[USEBLK] = B<TEMP,3>TEXTTBLWD[1];
              END 
          IF TEXTWC NQ 1  THEN
              PUTBIN(LOC(TEXTTBL), TEXTWC+1); 
          USEBLK = B<42,18>INSTR; 
              POSITION = USEPOS[USEBLK];
              LOCATION = USEORG[USEBLK];
          TEXTWC = 1; 
          TEXTTBLWD[1] = 0;            # CLEAR RELOCATION BITS         #
          TEXTS = LOCATION; 
          TEXTR = USEBLOCK[USEBLK]; 
          TEXTTBLWD[2] = 0; 
          IF POSITION NQ 0  THEN
              BEGIN 
              TEXTTBLWD[2] = USEPARTWD[USEBLK]; 
              B<0,3>TEXTTBLWD[1] = USEPARTRELS[USEBLK]; 
              END 
          IF LISTLINE  THEN 
              BEGIN 
              COUNT = LENLJZF(USENAME[USEBLK]); 
              TEMP = "          ";
              IF GLOBAL[USEBLK]  THEN 
                  BEGIN 
                  C<0,1>TEMP = "/"; 
                  C<1,COUNT>TEMP = C<0,COUNT>USENAME[USEBLK]; 
                  C<1+COUNT,1>TEMP = "/"; 
                  END 
              ELSE
                  C<0,COUNT>TEMP = C<0,COUNT>USENAME[USEBLK]; 
              C<7,3>ASMLINEWD[6] = C<0,3>TEMP;
              C<0,7>ASMLINEWD[7] = C<3,7>TEMP;
              END 
  
          END  # USEBLK NQ B<42,18>INSTR #
      ELSE
          C<0,1>ASMLINEWD [5] = "*";
  
  
          IF  USELABEL[USEBLK]  THEN RETURN;
          USELABEL[USEBLK] = TRUE;
          IF  USENAME[USEBLK] EQ "CODE" 
          THEN
          BEGIN 
          IF  LISTO AND LISTLINE  THEN
              CBLIST(1, ASMLINE, 136);
          IF  COMPASS AND LISTLINE  THEN
              WRITECOMPASS; 
          IF  LISTO OR COMPASS  THEN
              BEGIN 
              LISTLINE = TRUE;
              FOR I = 1 STEP 1 UNTIL 14  DO 
                  ASMLINEWD[I] = "          ";
              C<0,5>ASMLINEWD[6] = "ENTRY"; 
              COUNT = LENLJZF(IDENTNAME); 
              TEMP = "          ";
              C<0,COUNT>TEMP = C<0,COUNT>IDENTNAME; 
              C<7,3>ASMLINEWD[6] = C<0,3>TEMP;
              C<0,4>ASMLINEWD[7] = C<3,4>TEMP;
              IF  LISTO  THEN 
                  CBLIST(1, ASMLINE, 136);
              IF  COMPASS  THEN 
                  WRITECOMPASS; 
              LISTOCTAL(LOCATION, 3, 6);
              C<1,7>ASMLINEWD[5] = C<0,7>TEMP;
              ASMLINEWD[6] = "BSS    0  ";
              ASMLINEWD[7] = "          ";
              END       #LISTO OR COMPASS  #
          RETURN; 
          END    #USENAME[USEBLK] EQ "CODE" AND CODE$FLG EQ 0#
      IF  LISTO AND LISTLINE  THEN
          CBLIST(1, ASMLINE, 136);
      IF  COMPASS AND LISTLINE  THEN
          WRITECOMPASS; 
      IF  LISTO OR COMPASS  THEN
          BEGIN 
          FOR I = 1 STEP 1 UNTIL 14 DO
              ASMLINEWD[I] = "          ";
          LISTOCTAL(LOCATION, 3, 6);
          COUNT = LENLJZF(USENAME[USEBLK]); 
          C<1,1>ASMLINEWD[5] = "#"; 
          C<2,COUNT>ASMLINEWD[5] = C<0,COUNT>USENAME[USEBLK]; 
          C<0,8>ASMLINEWD[6] = "BSS    0";
          ASMLINEWD[11] = LINENUM;
          LISTLINE = TRUE;
          END 
  
          END   #OBJUSE#
 CONTROL EJECT; 
          PROC OBJVFD;
 # * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * #
 #                                                                     #
 #    NAME -     OBJVFD                                                #
 #                                                                     #
 #    PURPOSE -  GENERATE CODE AND LISTING FOR *VFD*                   #
 #                                                                     #
 # * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * #
  
          BEGIN 
          ITEM  PAIRNUM      I; 
          ITEM  CODELENGTHDG I; 
          ITEM  SAVEPOS      I; 
          ITEM   I           I; 
  
          PARM2 = B<28,14>INSTR;
  
          FOR  PAIRNUM = 2  STEP 2  UNTIL PARM2  DO 
              BEGIN 
              REL = 0;
              RELCHAR = O"55";   #BLANK#
              READINS(INSTR, EOF);
              IF EOF  THEN ASM2ABORT(4);
              CODELENGTH = B<0,12>INSTR;                  # BIT COUNT # 
              READINS(CODEWORD, EOF); 
              IF EOF  THEN ASM2ABORT(5);
#      MAKE SURE *POSITION* IS OK IN CASE OF EXTERNAL REFERENCE        #
          SAVEPOS = POSITION;          # BECAUSE *POSITION* IS TYPE U  #
          POSITION = POSITION + CODELENGTH - 30;
              TABLELOOKUP(TEMP);
          POSITION = SAVEPOS; 
          RELADDR = RELADDR + CODEWORD; 
              CODEWORD = CODEWORD + TEMP; 
              FIXLOCATION;
              TEMP = 60 - CODELENGTH;     # SIZE OF ZERO UPPER PART # 
              IF TEMP NQ 0  THEN
                  B<0,TEMP>CODEWORD = 0;
              TEMP = TEMP - POSITION;     # LEFT SHIFT COUNT FOR PLACE #
          B<POSITION,CODELENGTH>TEXTTBLWD[TEXTWC+1] = CODEWORD; 
              I = CODELENGTH + POSITION;
              IF (REL - 2) GR COMCOUNT THEN 
                  BEGIN 
                  ASM2ABORT (25); 
                  REL = 0;
                  END 
              IF REL NQ 0  THEN 
              BEGIN 
              IF REL EQ 1  AND
                 (I EQ 30  OR 
                  I EQ 45  OR 
                  I EQ 60    )  THEN
                  BEGIN 
                      COUNT = (4*TEXTWC - 4) + (I/15 - 2);
                  B<COUNT,2>TEXTTBLWD[1] = 2; 
                  END 
              ELSE
                  BEGIN 
              IF  I NQ 30 AND I NQ 45 AND I NQ 60  THEN ASM2ABORT(26);
              FILL$NAME[0] = O"4200";            #FILL TABLE           #
              FILL$WC[0] =01;                    #WORD COUNT           #
              FILL$CR[0] = 0;                    #CONDITIONAL LOAD     #
              FILL$HEADER[0] = 0; 
              FILL$BR[0] = REL;                  #COMMON BLOCK# 
              FILL$TRAILER[0] = 1;
              FILL$P[0] = (60-I)/15;             #PARCEL               #
              FILL$R[0] = USEBLOCK[USEBLK];      # BLOCK               #
              FILL$A[0] = LOCATION; 
              PUTBIN(LOC(FILLTBL[0]),2);
                  END 
              END 
  
              IF LISTO OR COMPASS  THEN 
                  BEGIN 
                  FOR COUNT = 1  STEP 1  UNTIL 9  DO
                      ASMLINEWD[COUNT] = "          ";
                  CODELENGTHDG = (CODELENGTH+2)/3;   # LENGTH IN OCTAL #
                  LISTOCTAL( CODEWORD,
                             11 + (POSITION+2)/3, 
                             CODELENGTHDG );
                  SETCHAR(12 + (POSITION+2)/3 + CODELENGTHDG, RELCHAR); 
                  C<0,3>ASMLINEWD[6] = "VFD"; 
                  IF  MINUS$FLAG EQ 2  THEN 
                      BEGIN 
                      C<0,1>ASMLINEWD [5] = "-";
                      MINUS$FLAG = 0; 
                      END 
                  IF POSITION EQ 0 THEN 
                      LISTOCTAL(LOCATION,3,6);
                  LISTOCTAL(CODELENGTH, 58, 2); 
                  SETCHAR(60, O"02");   #B# 
                  SETCHAR(61, O"50");   #/# 
                  IF  BLOCKNAME EQ 0  THEN
                      IF  COMMENT30 EQ "          "  THEN 
                          BEGIN 
                          LISTOCTAL(CODEWORD, 62, CODELENGTHDG);
                          SETCHAR(62+CODELENGTHDG, O"02");     #B#
                          END 
                      ELSE
                          BEGIN 
                          C<1,2>ASMLINEWD[7] = "=X";
                          C<3,7>ASMLINEWD[7] = C<0,7>COMMENT30; 
                          COMMENT30 = "          "; 
                          END 
                  ELSE
                      PUTADDR(62);
                  IF LISTO  THEN
                      CBLIST(1, ASMLINE, 136);
                  IF COMPASS  THEN
                      WRITECOMPASS; 
                  END 
  
              POSITION = POSITION + CODELENGTH; 
  
              IF POSITION EQ 60  THEN 
                  BEGIN 
                  POSITION = 0; 
                  LOCATION = LOCATION + 1;
                  TEXTWC = TEXTWC + 1;
                  END 
              IF POSITION GR 60  THEN ASM2ABORT(6); 
  
              END  #PAIRNUM#
  
          LISTLINE = FALSE; 
          END  #OBJVFD# 
 CONTROL EJECT;                                                          ASM2 
          PROC  INITIALIZE;                                              ASM2 
                                                                         ASM2 
 # * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * # ASM2 
 #                                                                     # ASM2 
 #   NAME -      INITIALIZE                                            # ASM2 
 #                                                                     # ASM2 
 #   PURPOSE -   INITIALIZE VARIOUS PROCESSES                          # ASM2 
 #                                                                     # ASM2 
 #   GIVEN-   CCTASSEMLIST[0] = TRUE IFF OBJECT LISTING WANTED         #
 #            CCTCOMPASS = BINARY ZERO IFF NO COMPASS SOURCE FILE      #
 #                       = LFN IFF COMPASS SOURCE FILE WANTED          #
 #                                                                     # ASM2 
 #   DOES -   OPENS THE LIST FILE IF AN ASSEMBLY LISTING IS WANTED     # ASM2 
 #                                                                     # ASM2 
 # * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * # ASM2 
                                                                         ASM2 
          BEGIN                                                          ASM2 
          ITEM  I;
          ITEM  LISTIT       B;        # IF TO PRINT TITLE             #
                                                                         ASM2 
  
  
          LINENUM = "          "; 
          COMMENT30 = "          "; 
          LISTO = CCTASSEMLIST[0];
          $BEGIN
          IF NOT LISTO  THEN
              BEGIN 
              IF BUG203C$LOW[1] EQ 0  THEN
                  LISTO = TRUE; 
              END 
          $END
  
          LISTIT = LISTO;              # PRINT TITLE IF FULL OBJ LIST  #
          $BEGIN
          IF BUG203C$LOW[1] NQ BUG203C$INF  THEN
              LISTIT = TRUE;           # IF ANY PARTIAL LISTING        #
          $END
  
          IF LISTIT  THEN 
              BEGIN 
              LISTTYP = "  OBJECT LISTING OF "; 
              CBLIST(LISTCTL"TITLE", LISTHED, 110); 
              CBLIST(LISTCTL"SUBTITLE", " ", 1);
              CBLIST(LISTCTL"EJECT"); 
              END 
  
          IF B<0,60>CCTCOMPASS EQ 0  THEN 
              COMPASS = FALSE;         # NO COMPASS SOURCE FILE        #
          ELSE
              BEGIN 
              COMPASS = TRUE;          # COMPASS SOURCE FILE WANTED    #
              COMPFITWORD[0] = B<0,60>CCTCOMPASS; 
              B<57,3>COMPFITWORD[0] = 3;    #SET BOTTOM OF WORD FOR CIO#
              END 
  
          INSOPEN;                     # OPEN PSEUDO-INSTRUCTION FILE  #
                                                                         ASM2 
          FOR  I = 1 STEP 1 UNTIL NEXTDEFS  DO  EXTLINK[I] = 0; 
          FOR  I = 1 STEP 1 UNTIL NOBJRTN   DO  OBJLINK[I] = 0; 
          NEXTWORK = 1; 
#  (REMAINDER OF INITIALIZING IS DONE IN *OBJIDENT*)                   #
                                                                         ASM2 
          END  #INITIALIZE#                                              ASM2 
 CONTROL EJECT;                                                          ASM2 
          PROC  EXTRACTPARMS;                                            ASM2 
                                                                         ASM2 
 # * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * # ASM2 
 #                                                                     # ASM2 
 #   NAME -      EXTRACTPARMS                                          # ASM2 
 #                                                                     # ASM2 
 #   PURPOSE -   EXTRACT PARAMETERS FROM INSTRUCTION WORD              # ASM2 
 #                                                                     # ASM2 
 #   GIVEN -  COBOL 5.0 PSEUDO-INSTRUCTION IN *INSTR*                  # ASM2 
 #                                                                     # ASM2 
 #   DOES -   EXTRACTS THE OPCODE AND PARAMETERS FROM *INSTR*          # ASM2 
 #            ACCORDING TO THE FORMAT CLASS (DERIVED FROM OPCODE)      # ASM2 
 #            AND PUTS THEM IN *OPCODE*, *PARM1*, *PARM2*, AND *PARM3* # ASM2 
 #            SETS COMMENT30 = BLANKS OR COMMENT.                      #
 #                                                                     # ASM2 
 # * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * # ASM2 
                                                                         ASM2 
                                                                         ASM2 
          BEGIN                                                          ASM2 
                                                                         ASM2 
          SWITCH  SPLIT  EPCLASS1,                                       ASM2 
                         EPCLASS2,                                       ASM2 
                         EPCLASS3,                                       ASM2 
                         EPCLASS4,
                         EPCLASS5;
                                                                         ASM2 
          RELCHAR = O"55";   # #
          COMMENT30 = "          "; 
          REL = 0;                              # ASSUME NO RELOCATION #
                                                                         ASM2 
          OPCODE = B<0,12>INSTR;
          IF OPCODE GQ OPNAMES"ENDOP"  THEN ASM2ABORT(9); 
          GOTO SPLIT[CLASS[OPCODE]];                                     ASM2 
                                                                         ASM2 
 EPCLASS1:                                                               ASM2 
          PARM1 = B<12,16>INSTR;                                         ASM2 
          PARM2 = B<28,16>INSTR;                                         ASM2 
          PARM3 = B<44,16>INSTR;                                         ASM2 
          RETURN;                                                        ASM2 
                                                                         ASM2 
 EPCLASS2:                                                               ASM2 
          PARM1 = B<12,16>INSTR;                                         ASM2 
          PARM2 = B<28,14>INSTR;                                         ASM2 
          PARM3 = B<42,18>INSTR;                                         ASM2 
          RETURN;                                                        ASM2 
                                                                         ASM2 
 EPCLASS3:                                                               ASM2 
          PARM1 = B<12,16>INSTR;                                         ASM2 
          PARM2 = B<28,16>INSTR;                                         ASM2 
          IF OPCODE EQ OPNAMES"JP$"  THEN 
              MINUS$FLAG = 1; 
          IF OPCODE EQ OPNAMES"EQ$"  AND  PARM1 EQ PARM2  THEN
              MINUS$FLAG = 1; 
          READINS(INSTR, EOF);
          IF EOF  THEN ASM2ABORT(10); 
          TABLELOOKUP(PARM3); 
          RETURN;                                                        ASM2 
                                                                         ASM2 
 EPCLASS4:                                                               ASM2 
          TABLELOOKUP(PARM3); 
          IF OPCODE EQ OPNAMES"RJ$"  THEN 
              MINUS$FLAG = 1; 
          RETURN;                                                        ASM2 
                                                                         ASM2 
 EPCLASS5:  
          PARM1 = B<12,16>INSTR;
          PARM2 = B<28,16>INSTR;
          PARM3 = B<44,16>INSTR;
          READINS(INSTR,EOF); 
          IF EOF  THEN ASM2ABORT(7);
          TABLELOOKUP(PARM4); 
          READINS(INSTR,EOF); 
          IF EOF  THEN ASM2ABORT(8);
          TABLELOOKUP(PARM5); 
          RETURN; 
  
          END  #EXTRACTPARMS#                                            ASM2 
          CONTROL EJECT;
          PROC PUTLDST; 
 # * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
 *
 *  NAME -       PUTLDST
 *
 *  PURPOSE      OUTPUT LDSET DIRECTIVE 
 *
 *  GIVEN        LDSET TABLE AND CCTLDSET LEN TO GIVE NBR OF ENTRIES
 *
 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * #
  
          BEGIN 
  
          DEF LDSETARISZ  #50#;   #INITIAL SIZE OF LDSET ARRAY# 
          DEF LDSETARGR  #10#;   #GROWTH FACTOR FOR LDSET ARRAY#
          BASED ARRAY LDSETARRAY [1:50000]; 
              BEGIN 
              ITEM LDSETAITEM      U(0,00,60);  #ENTIRE ITEM# 
              ITEM LDSETATNBR      U(0,00,12);   #TABLE NUMBER# 
              ITEM LDSETAWC        U(0,12,12);  #WORD COUNT#
              ITEM LDSETANAME      C(0,00,07);  #NAME TO PUT IN#
              END 
  
          ITEM ARRAYEND I = LDSETARISZ; 
          ITEM TOTALWC I = 0; 
          ITEM LOCALWC I = 0; 
          ITEM LOOPIND I; 
          ITEM HDRPOINTER I = 0;
          ITEM LIBTYPE  S:LDSETVAL; 
          ITEM TABNBR I;
          ITEM CCOL I;       #CURRENT COLUMN# 
          ITEM ECOL I = 99;  #EQUAL SIGN COLUMN#
          ITEM I I;          #ANYTHING# 
  
  
#     PROCEDURE TO PUT NAMES ON OUTPUT LIST                            #
  
          PROC   STUFFIT(NAME); 
          BEGIN 
  
          ITEM   NAME        I; 
          ITEM   CHR         I; 
          ITEM   INDX        I; 
  
          IF  CCOL GR 105  THEN    #NO ROOM LEFT ON CARD# 
              BEGIN 
              IF  LISTO  THEN      #FLUSH THE OLD CARD OUT# 
                  CBLIST(1, ASMLINE, 136);
              IF  COMPASS  THEN 
                  WRITECOMPASS; 
              CCOL = ECOL + 1;     #RESET STARTING COLUMN#
              FOR  I = 8 STEP 1 UNTIL 13  DO
                  ASMLINEWD[I] = "          ";
              END 
  
          INDX = (CCOL + 9) / 10; 
          CHR = CCOL - (10 * INDX) + 9; 
  
          IF  CCOL GR (ECOL + 1)  THEN #NOT FIRST NAME IN LIST# 
              BEGIN 
              C<CHR,1>ASMLINEWD[INDX] = "/";
              CHR = CHR + 1;
              CCOL = CCOL + 1;
              IF  CHR GR 9  THEN
                  BEGIN 
                  CHR = 0;
                  INDX = INDX + 1;
                  END        #CHR GR 9# 
              END  #CCOL GR (ECOL + 1)# 
  
          FOR  I = 0 STEP 1 UNTIL 9  DO 
              BEGIN 
              IF  C<I,1>NAME EQ " " OR C<I,1>NAME EQ 0  THEN
                  TEST; 
              C<CHR,1>ASMLINEWD[INDX] = C<I,1>NAME; 
              CHR = CHR + 1;
              CCOL = CCOL + 1;
              IF  CHR GR 9  THEN
                  BEGIN 
                  CHR = 0;
                  INDX = INDX + 1;
                  END        #CHR GR 9# 
              END       #FOR I = 0 STEP 1 ETC.# 
  
          END    #STUFFIT#
  
  
  
 #     PROCEDURE FOR PUTTING IN LDSET TABLE  #
          PROC INSERTTA;
          BEGIN 
          ITEM VLDSETIND I; 
          ITEM CHAR C(1); 
          ITEM  TEMPNAME C(7);
          ITEM  I1  I;
  
          LOCALWC = 0;
          LDSETAITEM [TOTALWC] = 0;   #ZERO OUT WORD# 
          LDSETATNBR [TOTALWC] = TABNBR;
          HDRPOINTER = TOTALWC; 
          TOTALWC = TOTALWC + 1;
          FOR LOOPIND = 1 STEP 1 UNTIL CCTLDSETLEN DO 
              BEGIN 
              VLDSETIND = VIRTUAL (TABLETYPE "LDSET$", LOOPIND);
              IF LDSETTYPE [VLDSETIND] NQ LIBTYPE 
              THEN
                  TEST; 
              IF LDSETOVL [VLDSETIND] NQ CURRENT$OVL
              THEN
                  TEST; 
 #     SUBSTITUTE BINARY ZEROS FOR BLANKS IN NAME # 
              CHAR = " "; 
              TEMPNAME = LDSETNAME [VLDSETIND]; 
              FOR I1 = 1 STEP 1 UNTIL LOOPIND - 1 DO
                  BEGIN   #REMOVE ANY DUPLICATES #
                  VLDSETIND = VIRTUAL (TABLETYPE "LDSET$", I1); 
                  IF LDSETTYPE [VLDSETIND] NQ LIBTYPE 
                  THEN
                      TEST I1;   #NOT A DUPLICATE#
                  IF TEMPNAME EQ LDSETNAME [VLDSETIND]
                  AND LDSETOVL [VLDSETIND] EQ CURRENT$OVL 
                  THEN
                      TEST LOOPIND;  #DUPLICATE - IGNORE# 
              END 
  
              IF  LISTO OR COMPASS  THEN
                  STUFFIT(TEMPNAME);             #ADD NAME TO LIST# 
  
              FOR I1 = 6 STEP -1 WHILE CHAR EQ " " DO 
                  BEGIN 
                  CHAR = C<I1, 1> TEMPNAME; 
                  IF CHAR EQ " "
                  THEN
                      C<I1, 1> TEMPNAME = O"00";
                  END 
              LDSETAITEM [TOTALWC] = 0;   #ZERO OUT WORD# 
              LDSETANAME [TOTALWC] = TEMPNAME;
              TOTALWC = TOTALWC + 1;
              LOCALWC = LOCALWC + 1;
              IF TOTALWC GR ARRAYEND - 2
              THEN
 #     TABLE MAY OVERFLOW - GROW IT BY GROWTH SIZE                     #
                  BEGIN 
                  ARRAYEND = ARRAYEND + LDSETARGR;
                  CMM$GLV (LDSETARRAY, LDSETARGR); #EXTEND# 
                  END 
              END 
          IF LOCALWC EQ 0 
          THEN
              TOTALWC = TOTALWC - 1;  #NULL IF NONE#
          ELSE
              LDSETAWC [HDRPOINTER] = LOCALWC;   #PUT IN WORD COUNT#
          RETURN; 
          END 
  
  
 #     BEGIN MAIN PROCEDURE OF PUTLDST  # 
  
 #     ASSIGN SPACE FOR LDSET ARRAY # 
          IF GROUP1FLAG EQ 0
          THEN
              BEGIN 
              GROUP1FLAG = CMM$AGR (1);  #ASGN GROUP ID 1#
              END 
          TEMP = CMM$ALV (LDSETARISZ, 1, 3, GROUP1FLAG, P<LDSETARRAY>,
              0); 
          LDSETAITEM [1] = O"70000000000000000000";  #LDSET TABLE HDR#
          LDSETAITEM [2] = O"00120001000000000000";  #PRESET HDR WC = 1#
          LDSETAITEM [3] = "          ";  #PRESET TO SPACES#
          TOTALWC = 4;    #SET WORD COUNT SO FAR# 
          IF  LISTO OR COMPASS  THEN
              BEGIN 
              IF  LISTO  THEN 
                  CBLIST(1, ASMLINE, 136);
              IF  COMPASS  THEN 
                  WRITECOMPASS; 
              FOR  I = 1 STEP 1 UNTIL 14  DO
                  ASMLINEWD[I] = "          ";
              ASMLINEWD[6] = "LDSET     ";
              CCOL = 58;
              STUFFIT("LIB=");
              ECOL = CCOL - 1;
              END 
          LIBTYPE = S"LIBRARY"; 
          TABNBR = O"0010"; 
          INSERTTA;    #PUT OUT LIBRARY TABLE#
          IF  LISTO OR COMPASS  THEN
              BEGIN 
              IF  LISTO  THEN 
                  CBLIST(1, ASMLINE, 136);
              IF  COMPASS  THEN 
                  WRITECOMPASS; 
              FOR  I = 7 STEP 1 UNTIL 13  DO
                  ASMLINEWD[I] = "          ";
              CCOL = 58;
              STUFFIT("USE=");
              END 
          LIBTYPE = S"USE"; 
          TABNBR = O"0016"; 
          INSERTTA;  #OUTPUT USE TABLE# 
          IF  LISTO OR COMPASS  THEN
              BEGIN 
              IF  LISTO  THEN 
                  CBLIST(1, ASMLINE, 136);
              IF  COMPASS  THEN 
                  WRITECOMPASS; 
              FOR  I = 7 STEP 1 UNTIL 13  DO
                  ASMLINEWD[I] = "          ";
              CCOL = 58;
              ECOL = 99;
              STUFFIT("OMIT="); 
              ECOL = CCOL - 1;
              END 
          IF CCTMAINSUB OR NOT CCTSUBPROGR
          THEN
              BEGIN     # OUTPUT OMIT IF NOT SUBCOMPILATION # 
              LIBTYPE = S"OMIT";
              TABNBR = O"0020"; 
              INSERTTA; 
              END 
          IF  LISTO OR COMPASS  THEN
              BEGIN 
              IF  LISTO  THEN 
                  CBLIST(1, ASMLINE, 136);
              IF  COMPASS  THEN 
                  WRITECOMPASS; 
              C<7,3>ASMLINEWD[6] = "PRE"; 
              ASMLINEWD[7] = "SET=555555";
              ASMLINEWD[8] = "5555555555";
              ASMLINEWD[9] = "5555B     ";
              FOR  I = 10 STEP 1 UNTIL 13  DO 
                  ASMLINEWD[I] = "          ";
              END 
          LDSETAWC [1] = TOTALWC - 2;   #PLUG COUNT - HEADER #
 #     OUTPUT PRESET TABLE# 
          PUTBIN (LOC(LDSETARRAY), TOTALWC-1);  #WRITE OUT LDSET TABLE# 
          CMM$FRV (LDSETARRAY);  #RELEASE SPACE FOR LDSET ARRAY#
          RETURN; 
          END 
 CONTROL EJECT;                                                          ASM2 
          PROC  GENOBJECTS;                                              ASM2 
                                                                         ASM2 
 # * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * # ASM2 
 #                                                                     # ASM2 
 #   NAME -      GENOBJECTS                                            # ASM2 
 #                                                                     # ASM2 
 #   PURPOSE -   GENERATE LOADER TABLE(S) FOR THE                      # ASM2 
 #               CURRENT COBOL 5.0 PSEUDO-INSTRUCTION                  # ASM2 
 #                                                                     # ASM2 
 #                 ADD TO *ASMLINE* IF *LISTO* IS TRUE.                # ASM2 
 #                                                                     # ASM2 
 #   GIVEN -  *OPCODE*                                                 # ASM2 
 #            *PARM1*, *PARM2*, *PARM3*                                # ASM2 
 #            TABLE OF OBJECT PARAMETERS INDEXED BY *OPCODE*           # ASM2 
 #            *LISTO*, *ASMLINE*                                       # ASM2 
 #                                                                     # ASM2 
 #   DOES -   UPDATES APPROPRIATE LOADER TABLES, AND                   # ASM2 
 #            FLUSHES THEM OUT WHEN FULL.                              # ASM2 
 #                                                                     # ASM2 
 #            INSERTS OBJECT CODE INTO *ASMLINE* IF *LISTO* IS TRUE    # ASM2 
 #                                                                     # ASM2 
 # * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * # ASM2 
                                                                         ASM2 
                                                                         ASM2 
          BEGIN                                                          ASM2 
                                                                         ASM2 
          SWITCH  GENOBJSW:OBJACT 
                    GENOBJ$NULL:NULL, 
                    GENOBJ$BDP:BDP, 
                    GENOBJ$BSS:BSS, 
                    GENOBJ$CODE:CODE, 
                    GENOBJ$DATA:DATA, 
                    GENOBJ$END$:END$, 
                    GENOBJ$IDENT:IDENT, 
                    GENOBJ$IM:IM, 
                    GENOBJ$LABEL:LABEL, 
                    GENOBJ$LINE:LINE, 
                    GENOBJ$NOTE:NOTE, 
                    GENOBJ$OVCAP:OVCAP, 
                    GENOBJ$OVLY:OVLY, 
                    GENOBJ$REPL:REPL, 
                    GENOBJ$USE:USE, 
                    GENOBJ$VFD:VFD; 
  
          GOTO GENOBJSW[OBJACTION[OPCODE]];                              ASM2 
 GENOBJ$NULL: 
          IF  LISTO OR COMPASS  THEN
              SETASMLINE; 
          RETURN;                                                        ASM2 
  
 GENOBJ$BDP:  
          OBJBDP; 
          RETURN; 
  
 GENOBJ$BSS:  
          OBJBSS; 
          RETURN; 
                                                                         ASM2 
 GENOBJ$CODE:                                                            ASM2 
          OBJCODE;                                                       ASM2 
          RETURN;                                                        ASM2 
  
 GENOBJ$DATA: 
          OBJDATA;
          RETURN; 
  
 GENOBJ$END$: 
          OBJEND$;
          RETURN; 
  
 GENOBJ$IDENT:  
          OBJIDENT; 
          RETURN; 
 GENOBJ$IM: 
          OBJIM;
          RETURN; 
  
 GENOBJ$LABEL:  
          OBJLABEL; 
          RETURN; 
  
 GENOBJ$LINE: 
          OBJLINE;
          RETURN; 
  
 GENOBJ$NOTE: 
          OBJNOTE;
          RETURN; 
  
 GENOBJ$OVLY: 
          OBJOVLY;
          RETURN; 
 GENOBJ$OVCAP:  
          OVCAP;
          RETURN; 
  
 GENOBJ$REPL: 
          OBJREPL;
          RETURN; 
  
 GENOBJ$USE:  
          OBJUSE; 
          RETURN; 
  
 GENOBJ$VFD:  
          OBJVFD; 
          RETURN; 
                                                                         ASM2 
          END  #GENOBJECTS#                                              ASM2 
 CONTROL EJECT;                                                          ASM2 
          PROC  SETASMLINE;                                              ASM2 
                                                                         ASM2 
 # * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * # ASM2 
 #                                                                     # ASM2 
 #   NAME -      SETASMLINE                                            # ASM2 
 #                                                                     # ASM2 
 #   PURPOSE -   PREPARES LINE FOR ASSEMBLY LISTING,                   # ASM2 
 #               INCLUDING MENMONICS FOR INSTRUCTION                   # ASM2 
 #                                                                     # ASM2 
 #   GIVEN -  *OPCODE*                                                 # ASM2 
 #            *PARM1*, *PARM2*, *PARM3*                                # ASM2 
 #            TABLE OF LIST PARAMETERS INDEXED BY *OPCODE*             # ASM2 
 #                                                                     # ASM2 
 #   DOES -   CLEARS *ASMLINE* TO ALL BLANKS                           # ASM2 
 #                                                                     # ASM2 
 #            INSERTS PICTURE FOR THIS OPCDOE INTO COLS 11-30          # ASM2 
 #                                                                     # ASM2 
 #            INSERTS EACH *PARMN* INTO *ASMLINE* AS DIRECTED          # ASM2 
 #                                                                     # ASM2 
 # * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * # ASM2 
                                                                         ASM2 
                                                                         ASM2 
          BEGIN                                                          ASM2 
                                                                         ASM2 
          ITEM  II           I;                                          ASM2 
          ITEM   COL         I; 
          ITEM   CHR         I = 0; 
                                                                         ASM2 
                                                                         ASM2 
          LISTLINE = TRUE;
          IF  LISTSWITCH[OPCODE] EQ 0  THEN 
              LISTLINE = FALSE; 
          IF  LISTLINE                                                   ASM2 
          THEN                                                           ASM2 
              BEGIN                                                      ASM2 
              FOR  II=1  STEP 1  UNTIL 14  DO                            ASM2 
                  ASMLINEWD[II] = "          ";                          ASM2 
              ASMLINEWD[6] = PICTURE1[OPCODE];                           ASM2 
              ASMLINEWD[7] = PICTURE2[OPCODE];                           ASM2 
              ASMLINEWD[8] = PICTURE3[OPCODE];
              C<3,7>ASMLINEWD[14] = 0;                                   ASM2 
              LISTOCTAL(PARM1, 40+COLPARM1[OPCODE], LENPARM1[OPCODE]);   ASM2 
              LISTOCTAL(PARM2, 40+COLPARM2[OPCODE], LENPARM2[OPCODE]);   ASM2 
              IF  LISTSWITCH[OPCODE] EQ 2  THEN 
                  C<0,1>ASMLINEWD[5] = "*";      #COMMENT LINE# 
              IF  BLOCKNAME EQ 0 AND COMMENT30 EQ "          "  THEN
                  LISTOCTAL(PARM3,40+COLPARM3[OPCODE],LENPARM3[OPCODE]);
              ELSE
                  PUTADDR(40+COLPARM3[OPCODE]); 
              IF  MINUS$FLAG EQ 1  THEN 
                  MINUS$FLAG = 2; 
              ELSE
                  IF  MINUS$FLAG EQ 2  THEN 
                      BEGIN 
                      C<0,1>ASMLINEWD [5] = "-";
                      MINUS$FLAG = 0; 
                      END 
              ASMLINEWD[11] = LINENUM;
              END  #LISTLINE#                                            ASM2 
          RETURN;                                                        ASM2 
                                                                         ASM2 
          END  #SETASMLINE#                                              ASM2 
 CONTROL EJECT;                                                          ASM2 
 # * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * # ASM2 
 #                                                                     # ASM2 
 #                                                                     # ASM2 
 #   NAME -      ASM2                                                  # ASM2 
 #                                                                     # ASM2 
 #   PURPOSE -   CONTROL ROUTINE FOR PASS 2 OF ASSEMBLER               # ASM2 
 #                                                                     # ASM2 
 #   GIVEN -  FILE OF COBOL 5.0 PSEUDO-INSTRUCTIONS                    # ASM2 
 #                                                                     # ASM2 
 #   DOES -   GENERATES CORRESPONDING OBJECT CODE                      # ASM2 
 #            OPTIONALLY PRINTS LISTING OF ASSEMBLY CODE               # ASM2 
 #                                                                     # ASM2 
 # * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * # ASM2 
                                                                         ASM2 
                                                                         ASM2 
          INITIALIZE;                                                    ASM2 
                                                                         ASM2 
          READINS(INSTR,EOF); 
          IF CCTIDBUG[0] AND NOT EOF THEN 
              BEGIN   # REOPEN TABLES FOR CID                          #
              TMREOP(TABLETYPE"DNT$");
              TMREOP(TABLETYPE"FNAT$"); 
              TMREOP(TABLETYPE"NAMET$");
              TMREOP(TABLETYPE"AUX$");
              TMREOP(TABLETYPE"PNT$");
              IF CCTSECTION[0] THEN 
                  PNTLEN = CCTPNTLEN - 2; 
              ELSE
                  PNTLEN = CCTPNTLEN - 1; 
              END 
                                                                         ASM2 
          FOR  INSTRUCTIONS=1  WHILE  NOT EOF  DO 
              BEGIN                                                      ASM2 
              OPCODE = B<0,12>INSTR;
              GENOBJECTS;                                                ASM2 
              IF  LISTO AND LISTLINE  THEN  CBLIST(1, ASMLINE, 136);
              IF COMPASS AND LISTLINE  THEN 
                  WRITECOMPASS; 
              LISTLINE = FALSE; 
               READINS(INSTR,EOF);
              END  #INSTRUCTIONS#                                        ASM2 
  
          IF COMPASS  THEN
              BEGIN 
              PUTSQ(UPTR, 0, 0);   # FLUSH BUFFER#
              RETRN;               #RETURN BUFFER#
              END 
                                                                         ASM2 
          IF  CCTABORT THEN ABORT;
          RETURN;                                                        ASM2 
                                                                         ASM2 
          END                                                            ASM2 
          TERM                                                           ASM2 
