*DECK             EDITOR
USETEXT   TSOURCE 
USETEXT   TTARGET 
USETEXT   TSYMCNS 
USETEXT   TCEXECQ 
USETEXT   TCOM39Q 
USETEXT   TCEXEC
PROC EDITOR; BEGIN
*CALL COMEX 
     DEF  NAM1 #NAME#;
#*******************************************************************# 
#*******************************************************************# 
     DEF RLA   #0#;      #RL NO.- ABS#
     DEF RLP   #1#;      #RL NO.- MAIN# 
     DEF RLX   #2#;      #RL NO.- XTRN# 
     DEF  RLC #3#;  #COMMON#
#*******************************************************************# 
     XREF BEGIN 
          PROC PTOBJ; 
       PROC  PRTABS;
          PROC PTLST; 
          PROC LTCFL; 
          PROC FIND;
##       PROC SRCH; 
##       PROC SOVER;
          PROC DUMP;
          PROC DMSG;
          PROC PNAM;
          PROC POST;
          PROC SYMABT;                                                   EDITOR 
          ITEM LINES;              # PAGE LINE COUNT                   #
          ITEM SHRTLST; 
          ITEM WHCHED;             # WHICH HEADING TO USE              #
      PROC BINOCT;
      PROC PTLSTV;
          ITEM PGNAIM;
    #XREF#END 
     DEF J863 #863#;         # SYMABT DIAGNOSTIC 863                   # EDITOR 
#*******************************************************************# 
     DEF ADCNS #S"QCFOP$"#;   #ADCN STATUS# 
#*******************************************************************# 
#*******************************************************************# 
     DEF  CIFB
               #B<57,1>OPTION EQ 1#;     #OBJ     B=1#
     DEF  CIFL
               #B<44,1>OPTION EQ 1#;     #LINE    O=1#
     DEF  LMAP
               #B<59-"X",1>OPTION EQ 1#; #STORAGE MAP     X=1#
     DEF  LXREF 
               #B<59-"R",1>OPTION EQ 1#; #CROSS REFERENCE R=1#
#*******************************************************************# 
     DEF  WBYT
               #10#;     #BYTES/WORD# 
     DEF WBITS
               #60#; #BITS/WORD#
     DEF GOCTP #42#;     #GENERATED LABEL OCTAL POSITION# 
     DEF  LOCTP 
               #57#;            #LAST OCT POSITION# 
     DEF  LBYTP 
               #54# ;             #LAST BYTE POSITION#
     DEF CNAM 
               #7#;            #CHAR/NAME#
     DEF BNAM 
               #36#;              #BITS/NAME# 
     DEF  DMAX
               #14#;             #MAX DIGITS# 
     DEF  PLBO5 
               #45,57#;         #15 BIT LIMITS# 
     DEF  PLBO6 
               #42,57#;         #18 BIT LIMITS# 
#*******************************************************************# 
     DEF  BLK6 #0#;           #SCOPE "BLANK"# 
     DEF  HBLK #O"55"#;  #BLANK#
     DEF HBLK2
               #O"5555"#;              #2 BLANKS# 
     DEF  BLKW
               #"          "#;     #BLANK WORD# 
     DEF  BLKZ
               #"         0"#;    #RIGHT JUST. "0"# 
     DEF  HZERO 
               #O"33"#;  #ZERO# 
     DEF  ZERO2 
               #O"3333"#;     #2 ZEROS# 
     DEF  ZEROW 
               #"0000000000"#;     #WORD OF ZEROS#
     DEF  HONE
               #O"34"#;  #"1"#
     DEF  HDOT #O"57"#;       #"."# 
     DEF HPLUS
               #O"45"#;  #+#
     DEF  HMNUS 
               #O"46"#;  #-#
     DEF  HAST #O"47"#;  #*#
     DEF HEQ
               #O"54"#;       #"="# 
     DEF HA 
               #O"01"#;       #"A"# 
     DEF  HG
               #O"07"#;             #"G"# 
     DEF HH 
               #O"10"#;       #"H"# 
     DEF  HBC 
               #O"5503"#;       #" C"#
     DEF  HBX 
               #O"5530"#;       #" X"#
     DEF  HBPLS 
               #O"5545"#;     #" +"#
     DEF HEQ0 
               #O"5433"#;           #"=0"#
     DEF  HEQ10 
               #O"543433"#;           #"=10"# 
     DEF  HEQB
               #O"5402"#;             #"=B"#
     DEF HH0
               #"0         "#;
     DEF HHB
               #"B         "#;
     DEF HH10A
               #"10A       "#;
     DEF HH10H
               #"10H       "#;
     DEF  HBSS
               #" BSS      "#;            #"BSS"# 
     DEF  HEND
               #"     END  "#;         #"END"#
     DEF HXJ
               #" XJ       "#;
     DEF  HXJO
               #SLA[0]#;    #60-BIT XJ INSTRUCTION# 
     DEF  HXJOC0
               #"0130000000"#;      #XJ OCTAL DISPLAY#
     DEF  HXJOC1
               #"4600046000"#;
#*******************************************************************# 
     DEF       NE   #NQ#; 
     DEF       LE   #LQ#; 
     DEF       GT   #GR#; 
     DEF       GO   #GOTO#; 
     DEF       TO   # #;
     DEF  NO   #NOT#; 
     DEF  PLOCT #PROCT#;      #PUT OCTAL# 
     DEF  PTLOC 
               #PROCT(CTXL,42,57,0,12)#;  #PUT LOCN#
     DEF  PRBLK 
               #FOR I = 1 STEP 1 UNTIL ECED DO CED[I]=BLKW#; #CLEAR#
#*******************************************************************# 
*CALL COM39B
     ITEM CFX I ,   #POINTER VARIABLE#
          CFN I ,   #BLOCK COUNT# 
          CFC I ;   #WORD COUNT#
#*******************************************************************# 
     DEF ECPF #509#;               #NEW MAX PIDL/FILL TABLE SIZE       #
     DEF ACPCSIZ #510#; 
     ARRAY ACPC[ACPCSIZ] S(1);     #ARRAY FOR PDL/FILL TABLES          #
# *** MAXIMUM NO. OF ENTRIES DETERMINED BY RL VALUES IN OTHER TABLES
          I.E.  RL = 0-2    RESERVED FOR ABSOLUTE/PROGRAM RELOC.
                RL = 3-77   CORRESPOND TO COMMON BLOCKS WHICH 
                              OCCUPY PIDLE TABLE ENTRIES, 2-76.#
          ITEM CPC  I(0,0,60),
                     #        =[O"7700 0001 000000000000",0], # 
#76#           CPC6  I(0, 0,30) =[O"7700000100",0], 
#76#           CPC7  I(0,30,30) =[0,0], 
               CPCI I(0,0,6) ,          #TABLE I.D.#
               CPCC I(0,12,12),         #WC # 
               CPCN C(0,0,7), 
               CPCL I(0,42,18), 
               CPF  I(0,0,30),     #FILL UPPER# 
               CPF1 I(0,30,30);    #FILL LOWER# 
          DEF  CCC  #CPCC[0]#  ;        #WC # 
     ITEM CPCX I    = 2, #PIDLE TABLE INDEX (=RL-1 FOR COMMON)# 
          CPFL I    = 0, #CURRENT AR #
          CPFX I    = 1, #FILL TABLE INDEX# 
          CPFB B    =FALSE;# FILL BYTE FLAG#
#*******************************************************************# 
     DEF ECPL  #64#;   #LINK# 
     DEF ECPE  #66#;   #ENTR# 
     ARRAY ACPE [0:ECPE]  S(1);    #ENTR,LINK TABLES# 
          ITEM CPE  I(0,0,60),
                     #        =[O"3600 0001 000000000000"],   # 
#76#           CPE6  I(0, 0,30) =[O"3600000100"], 
#76#           CPE7  I(0,30,30) =[0], 
               CPE1 I(1,0,60) =[33(0,O"1000000")],
               CPEC I(0,12,12),    #WC# 
               CPEN C(0,0,7), 
               CPEL I(1,42,18), 
               CPL  I(0,0,60),
               CPLN C(0,0,7), 
               CPLW U(0,59,1),     #WEAK EXTERNAL FLAG# 
               CPLI I(0,0,6),      #LINK ID#
               CPL0 I(0,0,30),
               CPL1 I(0,30,30); 
          DEF  CEC  #CPEC[0]#;     #WC# 
          DEF   CLC  #CPEC[0]#;    #LINK WC#
     ITEM CPEX I    =1,  #ENTR TABLE INDEX# 
          CPLX I    =1,  #LINK TABLE INDEX# 
          CPLL I    =0,  #CURRENT LINK L# 
          CPLB B    =FALSE;   #LINK BYTE FLAG#
#*******************************************************************# 
     ARRAY ACPX [0:1]     S(1);    #XFER TABLE# 
          ITEM CPX  I(0,0,60),
                     #        =[O"4600 0001 000000000000",0], # 
#76#           CPX6  I(0, 0,30) =[O"4600000100",0], 
#76#           CPX7  I(0,30,30) =[0,0], 
               CPXMM I(0,24,12),
               CPXDD I(0,36,12),
               CPXYY I(0,48,12),
               CPXN C(1,0,7); 
#**********************************************************************# JUNK 
#                                                                        JUNK 
         DEFINE CYBER INTERACTIVE DEBUGGER (CID)  TABLES                 JUNK 
               1) LINE NUMBER                                            JUNK 
               2) SYMBOL                                                 JUNK 
#                                                                        JUNK 
                                                                         JUNK 
      DEF ECILN #127#  ;      #MAX LENGTH OF LINE NUMBER TABLE  #        JUNK 
      DEF ECISY #100# ;      #MAX SIZE OF CID SYMBOL TABLE #             JUNK 
      DEF CIDLNG#2#   ;      # CID IDENTIFIER FOR OBJECT LANGUAGE #      JUNK 
                                                                         JUNK 
      DEF   CODENT  #2# ;   # SIZE OF LABEL,PROC,... ENTRY IN CISY #     JUNK 
      DEF   DATENT#2# ;     #         DATA ENTRIES #                     JUNK 
                                                                         JUNK 
      STATUS QCIDTYPE                                                    JUNK 
             NULL,                                                       JUNK 
             LOG ,                                                       JUNK 
             INT ,                                                       JUNK 
             REAL,                                                       JUNK 
             DOUB,                                                       JUNK 
             COMP,                                                       JUNK 
             BOOL,                                                       JUNK 
             CHAR;                                                       JUNK 
                                                                         JUNK 
                                                                         JUNK 
      ARRAY ACILN [0:ECILN]  S(1);                                       JUNK 
        ITEM  CILN   U( 0, 0,12) = [ O"5700" ] ,                         JUNK 
              CILNWC U( 0,12,12) = [ 0 ],                                JUNK 
              CILNLG U( 0,24,12) = [ CIDLNG ] ,                          JUNK 
              CILNOV U( 1, 0,60) ,                                       JUNK 
              CILNLB U( 1,0, 18) = [ECILN(0)] , # FTN-LABEL NUMBER       JUNK 
                                                    - NOT USED   #       JUNK 
              CILNLN U( 1,18,24) = [ECILN(0)] , # LINE NUMBER #          JUNK 
              CILNOC U( 1,42,18) = [ECILN(0)] ; # CODE ADDRESS #         JUNK 
                                                                         JUNK 
                                                                         JUNK 
      ARRAY ACISY  [0:ECISY ]  S(1) ;                                    JUNK 
        ITEM  CISY   U( 0, 0,12) = [ O"5600" ],                          JUNK 
              CISYWC U( 0,12,12) = [ 0 ] ,                               JUNK 
              CISYLG U( 0,24,12) = [ CIDLNG ],                           JUNK 
              CISYFT B( 0,41, 1) = [FALSE] ,   # FINAL TABLE MARKER #    JUNK 
              CISYA1 U( 0,42,18) = [ 0 ] ,    # DONT SAVE  A1 #          JUNK 
                                                                         JUNK 
              CISYOV U( 1, 0,60) = [ECISY(0)],  # ZERO IT  OUT #         JUNK 
              CISYNM C( 1, 0, 7) ,      # SYMBOL NAME #                  JUNK 
              CISYRB U(1,42, 9) ,       # RELOCATION BASE #              JUNK 
              CISYNE U( 1,51, 9) ,     # NUMBER OF WORDS IN THIS ENTRY#  JUNK 
                                                                         JUNK 
              CISYLC B( 2, 0, 1) ,     # LCM RESIDENT  #                 JUNK 
              CISYFP B( 2, 1, 1) ,     # FORMAL (NOT USED #              JUNK 
              CISYTY S:QCIDTYPE                                          JUNK 
                      ( 2, 4, 5) ,     # TYPE   #                        JUNK 
              CISYDM U( 2, 9, 5) ,     # NUMBER OF DIMENSIONS  #         JUNK 
              CISYCL U( 2,14,16) ,     # LENGTH OF CHAR  #               JUNK 
              CISYBC U( 2,32, 4) ,     # FIRST CHARACTER POSITION #      JUNK 
              CISYAD U( 2,42,18) ,     # ADDRESS  #                      JUNK 
                                                                         JUNK 
              CISYCB B( 3, 2, 1) ,     # CONSTANT BOUND #                JUNK 
              CISYLB B( 3, 3, 1) ,     # LOWER BOUND PRESENT #           JUNK 
              CISYBD I( 3,42,18) ;     # BOUND  (UPPER OR LOWER )  #     JUNK 
                                                                         JUNK 
      ITEM  CISYX = 0;      # INDEX INTO SYMBOL (56) TABLE #             JUNK 
      ITEM  CILNX = 0;      #            LINE   (57)       #             JUNK 
#*******************************************************************# 
     DEF  ECPT #16#;#TEXT TABLE SIZE# 
     ARRAY ACPT [0:16]    S(1);    #TEXT TABLE# 
          ITEM CPT  I(0,0,60),
                     #        =[O"4000 0006 0000 01 000000",
                                O"0042 1040 0000 0000 0000",0,
                                     O"4 0000 0010 00 0000",3(0), 
                                O"4300 0002 0000 0000 0000",
                                           O"1 001 00 0000",
                                    O"14 00001 001 00 0000" ],# 
#76#           CPT6  I(0, 0,30) =[O"4000000600",O"0042104000",0,
#76#                               O"0000040000",0,0,0, 
#76#                               O"4300000200",0,O"0000140000"],
#76#           CPT7  I(0,30,30) =[O"0001000000",0,0,O"0010 000000", 
#76#                               4(0),2(O"1001000000")],
               CPTC I(0,12,12),         #WC # 
               CPTRL I(0,36,6), 
               CPTL  I(0,42,18),
               CPTR  I(1,0,60), 
               CPRC I(7,0,60),
               CPRS I(8,42,18), 
               CPRD I(9,42,18); 
          DEF  CTC  #CPTC[0]# ;         #WC#
          DEF  CTR  #CPTR [0]#  ;       #RELOCATION WORD             76#
     ITEM CTXL I    = -1,     #CURRENT L,1107-FORCE NON-CONTIGUOUS   76#
          CTXR I    = 0,      #REL.BIT INDEX #
          CTXK I    = 0, #TEXT K INDEX# 
          CTXQ I    = 0, #TEXT 15-BIT BYTE INDEX# 
          CTX  I    = 2;      #TEXT TABLE INDEX#
               DEF CPTX #CTX#;
#*******************************************************************# 
               DEF  ECED
                         #12#;     #WDS/LINE-1 #
     ARRAY ACED [0:ECED] S(1);  #CODE EDIT# 
          ITEM CED0   I(0, 0,60), 
               CEDCC  C(0, 0,10) =[BLKW,ECED(BLKW)],
               CED    I(1, 0,60), 
               CEDOC  I(2, 0,60), 
               CEDL   I(4,18,42), 
               CEDL1  I(5, 0,18), 
               CEDM   C(5,24, 6), 
               CEDMI  I(5,42, 6), 
               CEDO   I(6, 0,60), 
               CEDOJ  I(6, 0,12), 
               CEDOK  I(6, 0,18), 
               CEDOJK I(6,12,18), 
               CEDOKJ I(6,18,18); 
     ITEM CEDR0 I = HBLK2;    #RELOC CHAR#
      DEF  CEDR 
               #B< 0,12>CED[2]#;   #RELOC CHAR[0]#
     DEF  CEDR1 
               #B<30,12>CED[2]#;   #RELOC CHAR[1]#
     DEF  CEDR2 
               #B< 0,12>CED[3]#;   #RELOC CHAR[2]#
     DEF  CEDOJP    #CEDOK[0]#;    #X/B/A I/J PUNCTUATION#
               DEF  WCED
                         #13#;     #WDS/LINE# 
               DEF  WCEDL 
                         #3#;      #LABL      POSITION# 
               DEF  BCEDL 
                         #18#;     #LABL BIT POSITION#
               DEF  WCEDM 
                         #4#;      #MNEM WORD POSITION# 
               DEF  WCEDO 
                         #5#;      #OPND WORD POSITION# 
     DEF  WOPND 
               #5#; #OPND WORD# 
     DEF  LCEDL 
               #10#;     #LABEL SIZE# 
     DEF  LCEDLW
               #7#;     #LABEL INDEX MAX.#
     DEF  PLLOC 
               #0,12#;          #LOC WRD,BIT# 
#*******************************************************************# 
     ARRAY ACEN [0:ECED] S(1);
          ITEM CEN  I(0,0,60),
               CENCC  C(0,0,10)  =[5(BLKW),"     USE  ",7(BLKW)], 
               CENM   C(5,0,10),
               CENO   I(6,0,60),
               CENN   C(6,6,7); 
#*******************************************************************# 
     ARRAY ACER [0:ECED]  S(1); 
          ITEM CER    C(0,0,10)  =[4(BLKW),"   *      ",8(BLKW)], 
               CERC   I(5,0,60);
#*******************************************************************# 
     ARRAY ACSL  [0:63] S(1);  #USE NAME TABLE# 
          ITEM CSL  I(0,0,60),
               CSLCC C(0,0,10) =[64(BLKW)], 
               CSL1 I(1,0,60),
               CSLN C(1,6,7); 
#*******************************************************************# 
     ARRAY ASLA [0:7] S(1);          #SLASH TABLE#
          ITEM SLA  I(0,0,60),
                    #FIRST ENTRY FOR XJ INSTRUCTION 
                              =[O"0130 000000 46000 46000", 
                                -O"500              0500 000000000000", 
                                -O"500 00           0500   0000000000", 
                                -O"500 0000         0500     00000000", 
                                -O"500 000000       0500       000000", 
                                -O"500 00000000     0500         0000", 
                                -O"500 0000000000   0500           00", 
                                -O"500 000000000000 0500             "]#
#76#           SLA6  I(0, 0,30) =[O"0130000000",O"0500050000",
#76#                               O"0500000500",O"0500000005", 
#76#                               4(O"0500000000")], 
#76#           SLA7  I(0,30,30) =[O"46000 46000", 
#76#                              3(0),O"0500000000",O"0005000000", 
#76#                               O"0000050000",O"0000000500"];
#*******************************************************************# 
#*******************************************************************# 
   ARRAY ACOP[0:QCFOP"WXJ"]    S(1);    # OPERATION CODE  #              LARRY-R
          ITEM COP I(0,0,60)=[ 0, 
                              O"003000",O"003100",O"003200",O"003300",
                              O"003400",O"003500",O"003600",O"003700",
                              O"004000",O"005000",O"006000",O"007000",
                              O"001100",O"001200",
                              O"001000",O"002000",0,
                              O"051000",O"061000",O"071000",
                              O"050000",O"060000",O"070000",
                              O"052000",O"062000",O"072000",
                              O"046000",
                              O"012000",
                              O"030000",O"032000",O"034000",O"036000",
                              O"013000",
                              O"031000",O"033000",O"035000",O"037000",
                              O"011000",
                              O"040000",O"041000",O"042000",
                              O"044000",O"045000",
                              O"010000",
                              O"053000",O"063000",O"073000",
                              O"054000",O"064000",O"074000",
                              O"055000",O"065000",O"075000",
                              O"056000",O"066000",O"076000",
                              O"057000",O"067000",O"077000",
                              O"014000",O"016000",O"017000",O"015000",
                              O"047000",
                              O"024000",O"025000",O"026000",O"027000",
                              O"022000",O"023000",
                              O"020000" ,         # LXI   #              LARRY-R
                              O"021000" ,         # AXI   #              LARRY-R
                              O"043000" ,         # MXI   #              LARRY-R
                              O"001400" ,         # RXJ   #              LARRY-R
                              O"001500"           # WXJ   #              LARRY-R
                                        ] ;                              LARRY-R
#*******************************************************************# 
   ARRAY ACMN [0:QCFOP"CNTL" ] S(1);   # MNEMONIC  #                     LARRY-R
          ITEM CMN C(0,0,10)=[  " VFD", 
                               " ZR ",   " NZ ",   " PL ",   " NG ",
                               " IR ",   " OR ",   " DF ",   " ID ",
                               " EQ ",   " NE ",   " GE ",   " LT ",
                               " REC",   " WEC",
                               " RJ ",   " JP ",   " PS ",
                               " SA0",   " SB0",   " SX0",
                               " SA0",   " SB0",   " SX0",
                               " SA0",   " SB0",   " SX0",
                               " NO ",
                               " BX0",
                               " FX0",   " DX0",   " RX0",   " IX0",
                               " BX0",
                               " FX0",   " DX0",   " RX0",   " IX0",
                               " BX0",
                               " FX0",   " RX0",   " DX0",
                               " FX0",   " RX0",
                               " BX0",
                               " SA0",   " SB0",   " SX0",
                               " SA0",   " SB0",   " SX0",
                               " SA0",   " SB0",   " SX0",
                               " SA0",   " SB0",   " SX0",
                               " SA0",   " SB0",   " SX0",
                               " BX0",   " BX0",   " BX0",   " BX0",
                               " CX0",
                               " NX0",   " ZX0",   " UX0",   " PX0",
                               " LX0",   " AX0",
                               " LX0",   " AX0",   " MX0",
                               " RX0" ,   " WX0"   ,                     LARRY-R
                               " LE ",   " GT "  ]; 
#*******************************************************************# 
     ARRAY ATXP   [0:6] S(1); #TEXT RELOC. BIT# 
          ITEM TXP  I(0,0,60)=[  O"10",O"04",O"02", 
                                 O"10",O"04",O"02",O"02"];
     ITEM TXPX I    = 0; #TEXT RELOCATION POSITION# 
#*******************************************************************# 
     ARRAY AFLP   [0:6] S(1); #FILL/LINK RELOC. BIT#
          ITEM FLP  I(0,0,60)=[  O"6001000000", 
                                  O"5001000000",
                                  O"4001000000",
                                  O"6001000000",
                                  O"5001000000",
                                  O"4001000000",
                                  O"4001000000" ];
#*******************************************************************# 
     ARRAY AD [0:13] S(1);     #DECIMAL#
          ITEM D  I(0,0,60),
               D5 C(0,0,5), 
               D6 C(0,0,6)   =[3("G     "),4("$$$$$$")],
               D66 I(0,36,24) =[0,O"555555",0,O"01000000",O"53000000",
                                              O"01555555",O"53555555"], 
#                  =["G     0000","G         ","G     0000",
                     "$$$$$$A000","$$$$$$$000", 
                     "$$$$$$A   ","$$$$$$$   "],                       #
          D7   C(0,0,7),
          DXPC S:QCLAS(7,0,6)=[S"QCLAS$"],
          DXPCC      I(7,6,54)=[0]; 
#*******************************************************************# 
     ARRAY ATENS [0:3] S(1);
          ITEM TENS I(0,0,60),
                    #          = [   100000000000000, 
                                    1000000000000000, 
                                   10000000000000000, 
                                  100000000000000000]#
#76#           TENS6 I(0, 0,30) =[O"0000265714",O"0003432772",
                                  O"0043415711",O"0543212741"], 
#76#           TENS7 I(0,30,30) =[O"2036440000",O"4461500000",
                                  O"5760200000",O"3542400000"]; 
#*******************************************************************# 
     ITEM POBJ B = TRUE;
     ITEM PLIN B = FALSE; 
     ITEM SLCX,BABX,ASQX;     #INDEX/POINTERS#
     ITEM NMX; #NAME POINTER# 
     DEF  NP   #NMX#; 
     ITEM LDSPL I= 0, 
          ADSPL I= 0, 
          CDSPL I= 0; 
     ITEM IXFRN C(10) = BLKW; 
     ITEM BLKRL I = 0;   #BLANK COMMON RL#
     ITEM IRL I;      #RL NO.#
     ITEM ITYP S:QTYPE; 
     ITEM IOP S:QCFOP;
     ITEM KOP S:QCFOP    =S"TERM";
     ITEM     IJK,IKK,IKKT,IST;    #CODE INDEX,TEMP#
     ITEM IKKD I = -1;
     ITEM IKKL; 
     ITEM IFLC I = RLX;  #FILE RL NO./1,P,RL,LOC #
     ITEM IC;  #CHAR COUNT# 
     ITEM IJ,IK;
          ITEM KW,KB;    #KK WORD,BIT INDEX#
     ITEM I,J,K,L;  #MAIN LOOP INDICES# 
     ITEM CMPX = 0 ;
     DEF COMLIM 
               #O"77"# ;
     ARRAY [3:COMLIM] S(1) ;       # COMMON BLOCKS ARRAY               #
          ITEM BLOCPST I(0,0,WBITS) = [ O"75"(0) ] ,
               BLOCNAM C(0,0,WBYT) ,
               BLOCSIZ I(0,42,18) ; 
     ARRAY COMARY[0:12] S(1) ;     # COMMON BLOCKS LINE                #
          ITEM COMBLNK C(0,0,10) = [ 13(BLKW) ] , 
               COMNUM  I(0,36,12) , 
               COMNUM1 I(0,48,6) ,
               COMNAM  C(1,0,10) ,
               COMNAM1 C(2,0,10) ,
               COMLEN  I(2,0,WBITS) , 
               COMLEN1 I(3,0,WBITS) ; 
      ITEM PRGML I = 0;            # PROGRAM LENGTH                    #
      ARRAY LNMSG[0:3]; 
          ITEM LNMSGI C(0,0,10) = 
              [" PROGRAM L","ENGTH     ","      B WO","RDS       "];
#*******************************************************************# 
$BEGIN
#*#  DEF CIFW #IF B<6,1>INTOPS EQ 1 THEN#;       #"W"#
#*#  DEF CIFX #IF B<5,1>INTOPS EQ 1 THEN#;       #"X"#
$END
#*#  DEF CIFY #IF B<4,1>INTOPS EQ 1 THEN#;       #"Y"#
$BEGIN
#*#  DEF  CDMPW #IF B<5,1>INTOPS EQ 1 THEN CDUMP(LOC(#; #DUMP X#
$END
#*******************************************************************# 
#*******************************************************************# 
     DEF  PPRX
         #PRTABS(ACPC)#;  #PUT PREFIX#
     DEF PPID 
               #PTOBJ(ACPC,CPCX)#; #PUT PIDLE TABLE#
     DEF PENT 
               #PTOBJ(ACPE,CPEX)#;  #PUT ENTR TABLE#
     DEF  PTEXT 
               #PTOBJ(ACPT,CTX)#;  #PUT TEXT TABLE# 
     DEF  PFILT 
               #PTOBJ(ACPC,CPFX)#;  #PUT FILL TABLE#
     DEF  PLNKT 
               #PTOBJ(ACPE,CPLX)#;  #PUT LINK TABLE#
      DEF  PXFER
               #PTOBJ(ACPX,2)#;     #PUT XFER#
#*******************************************************************# 
PROC PENTR;    #PUT RL,ENTR#
                                        #PENTR IS A SUBROUTINE INTERNAL#
                                        # TO THE EDITOR WHICH FORMATS  #
                                        # ENTR TABLE ENTRIES FOR ENTRY #
                                        # POINT NAMES (INCLUDING DEVICE#
                                        # NAMES IN MAIN PROGRAMS).     #
                                        # LINKAGE: PENTR (ENTRY POINT  #
                                        # NAME, ATTRIBUTE POINTERS SET #
                                        # ON ENTRY).                   #
     BEGIN#PENTR# 
#                  IJ = LOCN       #
#                  NP = NAME PART/0 IF NO NAME    # 
      IF NOT POBJ THEN RETURN; #NO OBJ# 
      #ELSE OBJ#
          IF CPEX GQ ECPE THEN
          BEGIN#ENTR TABLE FULL#
                    CEC = CPEX-1;  #ENTR WORD COUNT#
                    PENT;     #PUT ENTR TABLE#
                    CPEX = 1; #INITIALIZE ENTR TABLE INDEX# 
$BEGIN
#*#   CDMPW  ACPE),68,"PENT ENTR        "); 
$END
          END  #ENTR TABLE FULL#
          #ELSE - DEF NAME,LOCN TO ENTR TABLE#
              IF NMX EQ 0 THEN CPE [CPEX] = D[0];  #NO NAME#
              ELSE BEGIN#NOT NO NAME# 
               CPEN[CPEX] = NAM1[NMX];  #ENTR NAME# 
               IF NCHR[NP] LS CNAM THEN #"0" FILL # 
                    FOR I = NCHR[NP]*6 STEP 6 UNTIL BNAM DO 
                         B<I,6>CPE [CPEX] = BLK6; 
              END       #NOT NO NAME# 
               CPEL[CPEX] = IJ;    #ENTR LOC# 
              #RL ALWAYS = 1(RELATIVE TO PROGRAM ORIGIN)# 
               CPEX = CPEX+2; #INCR. ENTR TABLE INDEX#
          #END  - DEF NAME,LOCN TO ENTR TABLE#
      #END  OBJ#
     END#PENTR# 
#*******************************************************************# 
CONTROL EJECT;
PROC PTXTPN(L);     #TEST LOCN,CURRENT L# 
                                        #PTXTPN IS A SUBROUTINE INTER- #
                                        # NAL TO THE EDITOR WHICH      #
                                        # CONTROLS THE WRITING OF TEXT #
                                        # TABLES ONTO THE BINARY OBJECT#
                                        # PROGRAM FILE.                #
     BEGIN#PTXPN# 
          ITEM L;   #LOCN#
         IF CTXL EQ L THEN GOTO PTXTP2; #CONTIGUOUS#
          BEGIN#NOT CONTIGUOUS DATA STRING# 
               CTXL = L; #CURRENT L#
               GOTO PTXTP3;   #PUT TEXT TABLE#
           END #NOT CONTIGUOUS DATA STRING/TEXT TABLE OVERFLOW# 
ENTRY PROC PTXTPI;  #INCR,CHECK TEXT OVERFLOW#
      #BEGIN PTXTPI#
          CTXL = CTXL+1; #INCR CURRENT L# 
          IF NOT POBJ THEN RETURN; #NO OBJ# 
          #ELSE OBJ#
               CTXR = CTXR+4; #INCR REL BIT#
               CTX = CTX+1;   #INCR TEXT INDEX# 
               GOTO PTXTP2;   #CHECK OVERFLOW#
          #END  OBJ#
      #END   PTXTPI#
ENTRY PROC PTXTPO;  #TEXT TABLE OVERFLOW TEST#
     #BEGIN PTXTPO# 
PTXTP2: 
         IF CTX LQ 16 THEN RETURN;      #NO OVERFLOW# 
         GOTO PTXTP4; #PUT TEXT#
ENTRY PROC PTXTPP;  #TEST,PUT TEXT# 
PTXTP3: 
               IF CTX LQ 2 THEN GOTO PTXTP6; #NO TEXT ENTRIES#
         #BEGIN PUT TEXT TABLE# 
PTXTP4: 
$BEGIN
#*#   CDMPW  ACPT),42,"PTXTP4 TEXT      "); 
$END
                         CTC = CTX-1;   #TEXT WC# 
                         PTEXT;    #PUT TEXT #
                         CTX = 2;  #INIT TEXT INDEX#
                         CTXR = 0; #INIT REL BIT# 
                         CPTR[0] = 0;   #INIT REL WD# 
         #END   PUT TEXT TABLE# 
PTXTP6: 
               CPTL[0] = CTXL; #TEXT L# 
     #END   PTXTPO# 
     END  #PTXPN# 
#*******************************************************************# 
CONTROL EJECT;
PROC PTFIL;         #PUT FILL#
                                        #PTFIL IS A SUBROUTINE INTERNAL#
                                        # TO THE EDITOR WHICH WRITES   #
                                        # THE FILL TABLE ONTO THE      #
                                        # BINARY OBJECT PROGRAM FILE.  #
     BEGIN#PTFIL# 
                              IF CPFB THEN
                              BEGIN #LOWER UNUSED#
                                   CPFX = CPFX+1;  #INCR. FILL INDEX# 
                                   CPFB = FALSE;  #LOWER LOWER FLAG#
                              END  #LOWER UNUSED# 
                              CCC = CPFX-1;  #FILL WC#
                              PFILT;    #PUT FILL TABLE#
$BEGIN
#*#   CDMPW  ACPC),64,"PTFIL  FILL      "); 
$END
     END  #PTFIL# 
CONTROL EJECT;
#*******************************************************************# 
PROC PTLNK;         #PUT LINK#
                                        #PTLNK IS A SUBROUTINE INTERNAL#
                                        # TO THE EDITOR WHICH WRITES   #
                                        # THE LINK TABLE ONTO THE      #
                                        # BINARY OBJECT PROGRAM FILE.  #
     BEGIN#PTLNK# 
                              IF CPLB THEN
                              BEGIN #LOWER UNUSED#
                                   CPLX = CPLX+1;  #INCR LINK INDEX#
                                   CPLB = FALSE;   #LOWER LOWER FLAG# 
                              END  #LOWER UNUSED# 
                              CLC = CPLX-1;  #LINK WC#
                              PLNKT;    #PUT LINK TABLE#
$BEGIN
#*#   CDMPW  ACPE),68,"PTLNK   LINK     "); 
$END
     END  #PTLNK# 
#*******************************************************************# 
#*******************************************************************# 
      CONTROL EJECT ;                                                    JUNK 
      PROC  PTLINETAB (LINE,ADDRESS);                                    JUNK 
        BEGIN                                                            JUNK 
#                                                                        JUNK 
               OUTPUT  LINE NUMBER TABLE                                 JUNK 
               CID REQUIRES THAT LINE NUMBERS IN ONE TABLE ARE IN        JUNK 
               ASCENDING ORDER                                           JUNK 
#                                                                        JUNK 
        ITEM OLDLINE = -1;  # LINE NUMBER FROM PREVIOUS CALL #           JUNK 
        ITEM  LINE ,                                                     JUNK 
              ADDRESS;                                                   JUNK 
                                                                         JUNK 
        IF CILNX EQ  ECILN                                               JUNK 
        OR LINE LS OLDLINE  THEN                                         JUNK 
                                                                         JUNK 
#        BUFFER FULL OR LINE NUMBERS NOT IN ASCENDING ORDER  #           JUNK 
                                                                         JUNK 
          BEGIN     # OUTPUT  TABLE   #                                  JUNK 
                                                                         JUNK 
          CILNWC [0]  = CILNX ;                                          JUNK 
          PTOBJ ( ACILN , CILNX+1 ) ;                                    JUNK 
          CILNX = 0;                                                     JUNK 
                                                                         JUNK 
          FOR I = 0 STEP 1 UNTIL ECILN-1 DO                              JUNK 
            BEGIN                                                        JUNK 
            CILNOV[I] = 0;                                               JUNK 
            END                                                          JUNK 
                                                                         JUNK 
          END                                                            JUNK 
                                                                         JUNK 
        OLDLINE = LINE ;                                                 JUNK 
        CILNLN[CILNX] = LINE ;                                           JUNK 
        CILNOC[CILNX] = ADDRESS;                                         JUNK 
        CILNX = CILNX + 1;                                               JUNK 
        END  # PTLINETAB #                                               JUNK 
                                                                         JUNK 
                                                                         JUNK 
      PROC PTSYTAB;                                                      JUNK 
#                                                                        JUNK 
         OUTPUT CID SYMBOL TABLE                                         JUNK 
#                                                                        JUNK 
        BEGIN                                                            JUNK 
        ITEM I ;                                                         JUNK 
        CISYWC[0] = CISYX ;                                              JUNK 
        PTOBJ (ACISY , CISYX+1) ;                                        JUNK 
        CISYX =0;                                                        JUNK 
                                                                         JUNK 
        FOR I=0  STEP 1 UNTIL ECISY-1 DO                                 JUNK 
          BEGIN                                                          JUNK 
          CISYOV[I] = 0;                                                 JUNK 
          END                                                            JUNK 
        END                                                              JUNK 
      CONTROL EJECT;                                                     JUNK 
      FUNC XFRMTYP (SYMTYP)  S:QCIDTYPE ;                                JUNK 
        BEGIN                                                            JUNK 
#                                                                        JUNK 
          CONVERT  SYMPL-TYPE TO CID-TYPE                                JUNK 
#                                                                        JUNK 
        ITEM SYMTYP S:QTYPE ;                                            JUNK 
        IF SYMTYP EQ S"IGR"                                              JUNK 
        OR SYMTYP EQ S"STTS"                                             JUNK 
        OR SYMTYP EQ S"USI"                                              JUNK 
        THEN                                                             JUNK 
           BEGIN                                                         JUNK 
           XFRMTYP = S"BOOL" ;  # MAKE THIS BOOLEAN SO IT COMES OUT      JUNK 
                                  IN OCTAL  #                            JUNK 
           END                                                           JUNK 
        IF SYMTYP EQ S"REAL"  THEN                                       JUNK 
           BEGIN                                                         JUNK 
           XFRMTYP = S"REAL";                                            JUNK 
           END                                                           JUNK 
        IF SYMTYP EQ S"BOOL"  THEN                                       JUNK 
           BEGIN                                                         JUNK 
           XFRMTYP = S"BOOL";                                            JUNK 
           END                                                           JUNK 
        IF SYMTYP EQ S"HLTH"  THEN                                       JUNK 
           BEGIN                                                         JUNK 
           XFRMTYP = S"BOOL";   # THIS SHOULD BECOME CHAR WHENEVER       JUNK 
                                  FORTRAN AND CID SUPPORT IT  #          JUNK 
           END                                                           JUNK 
        RETURN;                                                          JUNK 
        END                                                              JUNK 
                                                                         JUNK 
                                                                         JUNK 
                                                                         JUNK 
      FUNC NAMEZERO ( I ) C(7);                                          JUNK 
#                                                                        JUNK 
         THIS FUNCTION RETURNS THE NAME AT SYMBOL TABLE ENTRY I          JUNK 
           WITH ZERO FILL                                                JUNK 
#                                                                        JUNK 
        BEGIN                                                            JUNK 
           ITEM I ,                                                      JUNK 
                CHAR C(7),                                               JUNK 
                TEMP;                                                    JUNK 
                                                                         JUNK 
                                                                         JUNK 
        CHAR = NAME[I];                                                  JUNK 
                                                                         JUNK 
        IF NCHR[I] LS TFC THEN                                           JUNK 
          BEGIN                                                          JUNK 
          TEMP = NCHR[I] * TBL;   # NUMBER OF BITS IN NAME  #            JUNK 
          B<TEMP , TFL -TEMP > CHAR = 0;                                 JUNK 
          END                                                            JUNK 
                                                                         JUNK 
        NAMEZERO = CHAR;                                                 JUNK 
                                                                         JUNK 
        END                                                              JUNK 
                                                                         JUNK 
CONTROL EJECT;
PROC PTLAB(NX);     #PUT LABL#
                                        #PTLAB IS A SUBROUTINE INTERNAL#
                                        # TO THE EDITOR WHICH PLACES   #
                                        # DATA NAMES OR PROCEDURE      #
                                        # LABELS INTO THE LABEL FIELD  #
                                        # OF THE PROGRAM LISTING.      #
                                        # LINKAGE: PTLAB(NX) WHERE NX =#
                                        # ATTRIBUTE INDEX OF LABEL.    #
     BEGIN#PTLAB# 
     DEF PTLAB0 
                       #B<0,42>NAM1[NMX]#;   #1ST 7 CHAR #
     DEF  PTLAB1
         #IF IC GR 7 THEN CEDL1[0]=B<42,18>NAM1[NMX]#; #NEXT 3 CHAR#
     DEF  PTLAB2
         #IF IC GR 7 THEN CEDL1[I]=B<42,18>NAM1[NMX]#; #NEXT 3 CHAR#
          ITEM NX;  #SYMBOL TABLE POINTER#
          ITEM I,J; #LOCAL LOOP VARIABLES#
                    FIND(NX,NMX);   #FIND NAME# 
                    IC = NCHR[NMX];    #NO. OF CHAR#
                    CEDL[0]= PTLAB0; #1ST 7 CHAR# 
                    PTLAB1;   #TEST,PUT NEXT 3 CHAR#
                    ELSE RETURN;     #1 WORD ONLY#
                    IF IC LQ 10 THEN RETURN;
                    #BEGIN LABEL ONLY#
                         I  = 1;   #LABEL FLD INDEX#
PTLB4:  
                         NMX = NMX+1; #INCR NAME POINTER# 
                         IC = IC-LCEDL; #DECR NCHR# 
                         CEDL[I] = PTLAB0;  #1ST 7 CHAR#
                         PTLAB2;   #NEXT 3 CHAR#
                         ELSE GOTO PTLB6; 
                         IF IC GR LCEDL THEN
                         BEGIN#MORE CHAR# 
                              IF I LS LCEDLW THEN 
                              BEGIN#NEXT WORD#
                                   I = I+1;  #INCR LABEL FLD INDEX# 
                                   GOTO PTLB4;
                              END  #NEXT WORD#
                         END  #MORE CHAR# 
                         #ELSE E-O-NAME#
PTLB6:  
                         PTLST(ACED);   #PUT LABEL ONLY#
                        FOR J = I+WCEDL STEP -1 UNTIL WCEDL DO
                             CED[J] = BLKW;       #CLEAR LINE#
                         CED0[0] = BLKW;     #CLEAR LINE NO.# 
                    #END   LABEL ONLY#
     END  #PTLAB# 
#*******************************************************************# 
CONTROL EJECT;
PROC PROCT(S,S1,SL,S3,S4);    #EDIT OCTAL#
                                        #PROCT IS A SUBROUTINE INTERNAL#
                                        # TO THE EDITOR WHICH CONVERTS #
                                        # A VALUE TO OCTAL DISPLAY     #
                                        # CHARACTERS AND PLACES THE    #
                                        # CHARACTERS INTO THE LINE     #
                                        # BUFFER. LINKAGE: PROCT(S,S1, #
                                        # SL,S3,S4) WHERE S = VALUE    #
                                        # S1 = STARTING BIT POSITION OF#
                                        # VALUE S  SL = BIT POSITION OF#
                                        # LAST OCTAL DIGIT IN    S3 =  #
                                        # LINE WORD INDEX  S4 = BIT    #
                                        # INDEX IN WORD S3.            #
     BEGIN#PROCT# 
          ITEM  S,SB,SL;      #SOURCE WORD,BYTE,LNG#
          ITEM  LX,LB;        #LINE INDEX,BYTE# 
          ITEM S1,   S3,S4; 
          SB = S1;            LX = S3;  LB = S4;
PROCT2: 
               B<LB,6>CED[LX] = B<SB,3>S+HZERO; #OCT TO HOL#
               IF SB GQ SL THEN RETURN;   #E-O-OCTAL# 
               #ELSE MORE OCTAL#
               SB = SB+3;  #STEP BIT INDEX# 
               IF LB EQ LBYTP THEN
               BEGIN#E-O-WORD#
                    LB = 0;   #INIT BYTE INDEX# 
                    LX = LX+1; #INCR LINE INDEX#
               END  #E-O-WORD#
               ELSE LB = LB+6;     #SAME WORD#
               GOTO PROCT2; 
     END  #PROCT# 
CONTROL EJECT;
#*******************************************************************# 
          PROC CVTOD ( (X) ) ;    #CONVERT OCTAL TO DECIMAL DISPLAY#
                                        #CVTOD IS A SUBROUTINE INTERNAL#
                                        # TO THE EDITOR WHICH CONVERTS #
                                        # A SIGNED OCTAL VALUE TO DECI-#
                                        # MAL DISPLAY CHARACTERS AND   #
                                        # PLACES THE CONVERTED VALUE   #
                                        # INTO THE LINE BUFFER. THE    #
                                        # VALUES MUST BE IN THE RANGE  #
                                        # -2E48 -1 TO +2E48 -1.        #
                                        # LINKAGE: CVTOD(X) WHERE X =  #
                                        # VALUE.                       #
     BEGIN #CVTOD#
          ITEM X;   #OCTAL NO.# 
          ITEM N,Q,I,J; #LOCAL TEMPS# 
          IF KB EQ WBITS THEN 
          BEGIN #E-O-WORD#
               KW = KW+1; 
               KB = 0;
          END   #E-O-WORD#
          IF X EQ 0 THEN
          BEGIN #ZERO#
  IF B<0,1>X EQ 1 THEN
            BEGIN       #-VE ZERO#
          B<KB,6>CED[KW] = HMNUS ; #"-"#
          KB = KB + 6 ; 
    END 
               B<KB,6>CED[KW] = HZERO;  #"0"# 
               RETURN;
          END  #ZERO# 
          #BEGIN - NON-ZERO#
               IF X LS 0 THEN 
               BEGIN#NEGATIVE#
                    N = -X;   #COMPLEMENT#
               B<KB,6>CED[KW] = HMNUS;  #"-"# 
               KB = KB+6;     #INCR BIT INDEX#
               IF KB EQ WBITS THEN
               BEGIN #E-O-WORD# 
                    KB = 0; 
                    KW = KW+1;
               END   #E-O-WORD# 
               END  #NEGATIVE#
               ELSE  N = X;             #POSITIVE#
               FOR I = 0  STEP 1 DO 
               BEGIN #I#
                    Q = N/10; 
                    D[I] = (N-Q*10)+HZERO;
                    IF Q EQ 0 THEN GOTO CVTOD2; #COMPLETE#
                    #ELSE NOT COMPLETE# 
                         N = Q; 
               END  #I# 
CVTOD2: 
               B<KB,6>CED[KW] = D[I];  #DIGIT#
                    IF I EQ 0 THEN RETURN;
                    I = I-1;
               KB = KB+6;     #INCR BIT INDEX#
               IF KB EQ WBITS THEN
               BEGIN #E-O-WORD# 
                    KB = 0; 
                    KW = KW+1;
               END   #E-O-WORD# 
               GOTO CVTOD2; 
          #END   - NON-ZERO#
     END  #CVTOD# 
CONTROL EJECT;
#*******************************************************************# 
          PROC CVRTD ( (X) ) ;    # 60-BIT OCTAL -DECIMAL CONVERT#
                                        #CVRTD IS A SUBROUTINE INTERNAL#
                                        # TO THE EDITOR WHICH,LIKE     #
                                        # CVTOD, CONVERTS A SIGNED     #
                                        #OCTAL VALUE TO DECIMAL DIS-   #
                                        # PLAY CHARACTERS AND PLACES   #
                                        # THE CONVERTED VALUE INTO THE #
                                        # LINE IMAGE BUFFER. HOWEVER,  #
                                        # MAY BE IN THE RANGE -2E59 -1 #
                                        # TO +2E59 -1.                 #
                                        # LINKAGE: CVRTD(X) WHERE X =  #
                                        # VALUE.                       #
     BEGIN#CVRTD# 
          ITEM X;   #OCTAL NO.# 
          ITEM I,J,N,Q; #LOCAL TEMPS# 
          IF X EQ 0 THEN
          BEGIN #ZERO#
  IF B<0,1>X EQ 1 THEN
            BEGIN       #-VE ZERO#
          B<KB,6>CED[KW] = HMNUS ; #"-"#
          KB = KB + 6 ; 
    END 
               B<KB,6>CED[KW] = HZERO;  #"0"# 
               RETURN;
          END  #ZERO# 
          #BEGIN - NON-ZERO#
               IF X LS 0 THEN 
               BEGIN#NEGATIVE#
                    N = -X;   #COMPLEMENT#
                    B<KB,6>CED[KW] = HMNUS;  #"-"#
                    KB = KB+6;     #INCR BIT INDEX# 
               END  #NEGATIVE#
               ELSE N = X;    #POSITIVE#
         IF N LQ TENS[0] THEN 
         BEGIN#< MAX# 
               CVTOD(N);
               RETURN;
         END  #< MAX# 
         #BEGIN >MAX# 
          FOR J = 3 STEP -1 UNTIL 0     DO
          BEGIN#J#
               IF N GQ TENS[J] THEN 
               BEGIN#>/=# 
                  N = N-TENS[J];
                  Q = HONE;   #"1"# 
                  FOR I = J STEP -1 UNTIL 0 DO
                  BEGIN#I#
CVRTD2: 
                    IF N GQ TENS[I] THEN
                    BEGIN#DECREMENT#
                        Q = Q+1;  #INCR#
                        N = N-TENS[I]; #DECR NO.# 
                        GOTO CVRTD2;
                    END  #DECREMENT#
                    #ELSE PUT DIGIT#
                        B<KB,6>CED[KW] = Q; 
                        KB = KB+6;     #INCR BIT INDEX# 
                        Q = HZERO;
                    #END  PUT DIGIT#
                  END  #I#
                  GOTO CVRTD4;
               END  #>/=# 
          END  #J#
          #CONVERT REMAINDER# 
CVRTD4: 
               I = 0; 
CVRTD5: 
               IF N EQ 0 THEN GOTO CVRTD6;
               #ELSE CONVERT# 
                    Q = N/10; 
                    D[I] = (N-Q*10)+HZERO;
                    N = Q;
                    I = I+1;
                    GOTO CVRTD5;
               #END  CONVERT# 
CVRTD6: 
          IF I LS DMAX THEN 
         BEGIN #ZERO FILL#
               FOR J = I STEP 1 UNTIL DMAX DO 
               BEGIN#J# 
                    B<KB,6>CED[KW] = HZERO; 
                    IF KB EQ LBYTP THEN 
                    BEGIN #NEW WORD#
                         KB = 0;
                         KW = KW+1; 
                    END  #NEW WORD# 
                    ELSE KB = KB+6;     #SAME WORD# 
               END  #J# 
         END   #ZERO FILL#
CVRTD8: 
               IF I EQ 0 THEN RETURN; 
               #ELSE MORE DIGITS# 
                    I = I-1;
                    B<KB,6>CED[KW] = D[I];  #DIGIT# 
                    IF KB EQ LBYTP THEN 
                    BEGIN #NEW WORD#
                         KB = 0;
                         KW = KW+1; 
                    END   #NEW WORD#
                    ELSE KB = KB+6;     #SAME WORD# 
                    GOTO CVRTD8;
               #END  MORE DIGITS# 
         #END   >MAX# 
          #END   - NON-ZERO#
     END  #CVRTD# 
#*******************************************************************# 
CONTROL EJECT;
#*******************************************************************# 
#*******************************************************************# 
# PREFIX TABLE# 
     SWITCH    SESDC:QESDC
               PID02:NULL,
               PID20:CODE,
               PID02:DATA,
               PID10:ADCN,
               PID11:LITL,
               PID30:COMM,
               PID02:CMPL,
               PID02:FILE,
               PID42:XTRN;
#*******************************************************************# 
#*** E N T R Y  P O I N T ***#
PID00:  
      IF NNAM[SCPN[0]] THEN 
      BEGIN#NO NAME#
       NNAM[SCPN[0]] = FALSE;       #LOWER NO NAME FLAG#
       IKKL = PGNAIM;    #COMPILER SUPPLIED NAME# 
       FOR I = LBYTP STEP -6 UNTIL 0    DO
          IF B<I,6>IKKL NQ 0 THEN GOTO PID002;
          ELSE B<I,6>IKKL = HBLK;       #BLANK PAD# 
       I = 0; 
PID002: 
       PNAM(IKKL,I/6+1,NP);        #POST NAME#
       NLNK[SCPN[0]] = NP;         #LINK NAME#
      END  #NO NAME#
      ELSE FIND(SCPN[0],NP);      #NOT NO NAME# 
$BEGIN
#**#  CIFY  SDUMP(512);  #SYMBOL TABLE DUMP#
$END
      IF DPLC NQ 0 THEN LDSPL = SSIZ[DPLC];            #CNST DISPL# 
      IF LPLC NQ 0 THEN ADSPL = SSIZ[LPLC]+LDSPL;      #ADCN DISPL# 
      ELSE ADSPL = LDSPL; 
      IF APLC NQ 0 THEN CDSPL = SSIZ[APLC]+ADSPL;      #CODE DISPL# 
      ELSE CDSPL = ADSPL; 
      SLCX = SPLC;  #FIRST SLC POINTER# 
     IF NOT CIFB THEN POBJ = FALSE;     #NO OBJ#
     ELSE BEGIN#OBJ#
#    **NP = PROGRAM NAME POINTER** #
      CPCN[1] = NAME[NP];   #NAME TO PREFIX(,PIDLE)#
      FOR I = BNAM STEP -6 DO 
      BEGIN#I#
          IF B<I,6>CPCN[1] NQ HBLK THEN GOTO PID01; 
          #ELSE# B<I,6>CPCN[1] = 0;     #ZERO FILL# 
      END  #I#
PID01:  
      CPEX=1; 
      PPRX;    #PUT PREFIX# 
      IF CPLC NQ 0 THEN CPCL[1] = SSIZ[CPLC]+CDSPL;   #PROG SIZE# 
      ELSE CPCL[1] = CDSPL; 
          PRGML=CPCL[1];
#PIDLE,ENTR TABLES# 
      CPCI[0] = O"34";   #PIDLE CN# 
     END       #OBJ#
     IF NOT CIFL THEN GOTO PID04; #NO LINE# 
     #ELSE LINE#
      PLIN = TRUE;
      GOTO PID04; 
     #END  LINE#
PID02:  
      SLCX = ASEQ[SLCX]; #NEXT SLC LINK#
   #SLC CHAIN#
PID04:  
      IF SLCX EQ 0 THEN GOTO PID70; #E-O-SLC# 
      BABX = BABY[SLCX]; #INDEX TO ENTRIES - SLC"S BABY#
      GOTO SESDC [ESDC[SLCX]]; #BRANCH ON ESDC# 
#ADCN#
PID10:  
      IKK = ADSPL;  #ADCN ADJ#
      GOTO PID12; 
#CNST#
PID11:  
      IKK = LDSPL;  #CNST ADJ#
PID12:  
      IF BABX EQ 0 THEN GOTO PID02; #E-O-CHAIN# 
      #ELSE CNST/ADCN#
         LOCN[BABX] = LOCN[BABX]+IKK;        #ADJUST LOCN#
          RLNO[BABX] = RLP;   #PROGRAM RL#
          BABX = ASEQ[BABX];  #NEXT ADCN LINK#
          GOTO PID12; 
      #END  CNST/ADCN#
#CODE#
PID20:  
     IF BABX EQ 0 THEN GOTO PID02; #E-O-CHAIN#
     #ELSE LABEL# 
          LOCN[BABX] = LOCN[BABX]+CDSPL; #ADJUST LOCN#
      IF CLAS[BABX] EQ S"PROG" THEN 
          BEGIN#MAIN PROGRAM# 
              IFLC = RLP ;    #FILE RL NO.# 
              IF NNAM[BABX] THEN
              BEGIN#NO NAME#
               IJ = LOCN[BABX]; 
               IXFRN = D[1];  #"G     0   "#
               J = 6;    #BYTE INDEX# 
               FOR I = GOCTP STEP 3 UNTIL LOCTP DO
               BEGIN#I# 
                    B<J,6>IXFRN = B<I,3>IJ+HZERO; 
                    J = J+6;  #INCR BYTE INDEX# 
               END  #I# 
               IF POBJ THEN CPXN[0] = IXFRN; #OBJ#
               GOTO PID22;
              END  #NO NAME#
              #ELSE NOT NO NAME#
               FIND(BABX,NP);   #FIND NAME# 
               IXFRN = NAM1[NP];    #XFER NAME# 
              IF POBJ THEN
              BEGIN#OBJ#
               CPXN[0] = IXFRN; 
               IF NCHR[NP] LS CNAM THEN #"0" FILL # 
                    FOR I = NCHR[NP]*6 STEP 6 UNTIL BNAM DO 
                         B<I,6>CPXN[0] = BLK6;
              END  #OBJ#
              #END  NOT NO NAME#
          END 
PID22:  
          BABX = ASEQ[BABX]; #CODE/CNST LINK# 
          GOTO PID20; 
     #END  LABEL# 
#COMMON#
PID30:  
      IF POBJ OR PLIN THEN
      BEGIN#OBJ/LINE# 
       IF NNAM[SLCX] THEN 
       BEGIN#BLANK COMMON#
        IF POBJ THEN
        BEGIN#OBJ#
          CPC [CPCX] = BLKW;       #BLANK TO PIDLE TABLE# 
          CPCL[CPCX] = SSIZ[SLCX]; #BLOCK SIZE TO PIDLE TABLE#
        END  #OBJ#
        IF PLIN THEN CSL1[CPCX] = "//        ";   #LINE#
       END  #BLANK COMMON#
       ELSE BEGIN#LABELED COMMON# 
       FIND(SLCX,NMX);
        IJ = NCHR[NMX]; 
        IF POBJ  THEN 
        BEGIN #OBJ# 
          CPC [CPCX] = NAM1[NMX];  #BLOCK NAME TO PIDLE TABLE#
          IF IJ LS CNAM THEN #"0" FILL #
               FOR I = IJ*6 STEP 6 UNTIL BNAM DO
                    B<I,6>CPCN[CPCX] = BLK6;
          CPCL[CPCX] = SSIZ[SLCX]; #BLOCK SIZE TO PIDLE TABLE#
          IF  LEVL[BABY[SLCX]] GQ  QLEVEL"LEV2"  THEN                    LARRY-R
            BEGIN            #  LCM/ECS  BLOCK       #                   LARRY-R
            CPCL[CPCX]  = (CPCL[CPCX]+7) / 8  ;    # SIZE / 8     #      LARRY-R
            B<0> CPCL[CPCX] =  1;               # DEFINE AS LCM  #       LARRY-R
            END                                                          LARRY-R
        END   #OBJ# 
        IF PLIN THEN
        BEGIN#LINE# 
          CSLN[CPCX] = NAME[NP];
          IF IJ LS 7 THEN CSL1[CPCX] = CSL1[CPCX]-SLA[IJ];
          ELSE CSL1[CPCX] = CSL1[CPCX]-SLA[7];
        END  #LINE# 
       END       #LABELED COMMON# 
      END  #OBJ/LINE# 
          IF CPCX LS ECPF THEN
              CPCX = CPCX + 1;                 #INCR COMBLOCK COUNT    #
          ELSE
              SYMABT(J863,"TOO MANY COMMON BLOCKS(EDITOR)",30);          EDITOR 
##       # SET RLNO IN CLAS"COMM" FOR MAP # 
##       ITEM $BOOL B, $PTR I;
##       IF NNAM[SLCX] THEN GOTO PID34; 
##       FIND(SLCX,NMX);
##       SRCH(NMX,$BOOL,$PTR);
##  L$$:  
##       IF NOT $BOOL THEN GOTO PID34;
##       IF CLAS[$PTR] NQ S"COMM" THEN BEGIN
##            SOVER($PTR);
##            GOTO L$$; 
##       END
##       RLNO[$PTR] = CPCX; 
        B<0,42>BLOCNAM[CPCX] = B<0,42>NAME[NMX];
          BLOCSIZ[CPCX] = SSIZ[SLCX] ;
          GOTO PID34; 
   #COMMON BLOCK SCAN#
PID32:  
      BABX = ASEQ[BABX]; #NEXT COMMON BLOCK ENTRY POINTER#
        #ASSIGN RL TO COMMON BLOCK ELEMENTS - SLC"S BABY# 
PID34:  
          IF BABX EQ 0 THEN GOTO PID02; #E-O-BLOCK ELEMENTS#
          #ELSE - BLOCK ELEMENT#
            IF CLAS[BABX] EQ S"OVER" THEN GOTO PID32;  #OVER# 
            #ELSE NOT OVER# 
               RLNO[BABX] =CPCX;   #POST RL#
               IF CLAS[BABX] NQ S"TABL" THEN GOTO PID32;
               #ELSE - ASSIGN RL TO TABLE ELEMENTS - BABY"S ASEQ# 
                    IF TTYP[BABX] EQ S"BASED" THEN IRL = 0; #BASED# 
                    ELSE IRL = CPCX;      #NOT BASED# 
                    ASQX = BABY[BABX];
PID36:  
                    IF ASQX EQ 0 THEN GOTO PID32; #E-O-TABLE ELEMENTS#
                    #ELSE - TABLE ELEMENT#
                         IF CLAS[ASQX] NQ S"OVER" THEN RLNO[ASQX] = IRL;
                         ASQX = ASEQ[ASQX];  #FOLLOW ASEQ LINK# 
                         GOTO PID36;
                    #END  - TABLE ELEMENT#
               #END TABLE#
            #END  NOT OVER# 
#XTRN#
PID40:  
          BABX = ASEQ[BABX];   #NEXT XTRN LINK# 
PID42:  
          IF BABX EQ 0 THEN GOTO PID02; #E-O-XTRN#
          #ELSE XTRN# 
               RLNO[BABX] = RLX;   #XTRN RL#
               IF CLAS[BABX] NQ S"TABL" THEN GOTO PID40; #NOT TABLE#
               #ELSE TABL - ASSIGN RL TO BABY"S ASEQ# 
                    IF TTYP[BABX] EQ S"BASED" THEN IRL = 0; #BASED# 
                    ELSE IRL = 2;         #NOT BASED# 
                    ASQX = BABY[BABX];
PID44:  
                    IF ASQX EQ 0 THEN GOTO PID40; #E-O-TABL ELEMENTS# 
                    #ELSE - TABLE ELEMENT#
                         RLNO[ASQX] = IRL;   #POST RL#
                         ASQX = ASEQ[ASQX];  #FOLLOW ASEQ LINK# 
                         GOTO PID44;
               #END TABL# 
#PIDLE TABLE COMPLETE#
PID70:  
          IF POBJ THEN
          BEGIN#OBJ#
               CCC = CPCX-1;  #PIDLE WC#
               PPID;     #PUT PIDLE#
$BEGIN
#*#   CDMPW  ACPC),64,"PID70 PIDLE      "); 
$END
          END  #OBJ#
#*******************************************************************# 
#ENTR TABLE#
     SLCX = DPLC;  #DATA,CODE SLC"S#
PID72:  
     IF  CPLC EQ 0 THEN GOTO PID78; #NO CODE# 
     #ELSE CODE#
      BABX = BABY[CPLC];
     #END  CODE#
PID73:  
      IF BABX NQ 0 THEN 
      BEGIN #CODE/DATA# 
      RLNO[BABX] = RLP;       #PROGRAM RL#
      IF XTRN[BABX] NQ S"ENT" THEN GOTO PID75;
      #ELSE - DEF"D, TO ENTR TABLE# 
         IJ = LOCN[BABX];     #ENTRY POINT# 
         IF NNAM[BABX] THEN 
         BEGIN#NO NAME# 
               NMX = 0;  #NO NAME FLAG# 
               D[0] = D[2];   #G     0000#
               J = 6;    #BYTE INDEX# 
               FOR I = GOCTP STEP 3 UNTIL LOCTP DO
               BEGIN#I# 
                    B<J,6>D[0]  = B<I,3>IJ+HZERO; 
                    J = J+6;  #INCR BYTE INDEX# 
               END  #I# 
               PENTR;         #ENTR NAME# 
               GOTO PID75;
         END  #NO NAME# 
         #ELSE NOT NO NAME# 
               FIND(BABX,NP);      #NAME# 
               PENTR;         #ENTR NAME# 
         #END  NOT NO NAME# 
      #END  - DEF"D, TO ENTR TABLE# 
PID75:  
          IF CLAS[BABX] EQ S"TABL" THEN 
          BEGIN #TABLE# 
               IF TTYP[BABX] EQ S"BASED" THEN  IRL = 0; #BASED# 
               ELSE IRL = 1;  #NOT BASED# 
               ASQX = BABY[BABX];   #BABY"S ASEQ# 
PID76:  
               IF ASQX NQ 0 THEN
               BEGIN #TABLE ELEMENTS# 
                    IF CLAS[ASQX] NQ S"OVER" THEN RLNO[ASQX] = IRL; 
                    ASQX = ASEQ[ASQX];   #NEXT ELEMENT# 
                    GOTO PID76; 
               END   #TABLE ELEMENTS# 
          END   #TABLE# 
      #END  NOT OVER# 
PID77:  
          BABX = ASEQ[BABX]; #NEXT CODE/DATA POINTER# 
          GOTO PID73; 
      END   #CODE/DATA# 
PID78:  
     IF SLCX EQ 0 THEN GOTO PID80; #E-O-CODE,DATA#
     #ELSE DATA#
          BABX = BABY[SLCX];
          SLCX = 0; 
          GOTO PID73; 
     #END  DATA#
PID80:  
      IFLC=RLX; 
PID88:  
     IF POBJ THEN 
     BEGIN#OBJ# 
      IF CPEX GR 1 THEN 
      BEGIN#ENTR# 
      CEC = CPEX-1; #ENTR WORD COUNT# 
      PENT;    #PUT ENTR TABLE# 
$BEGIN
#*#   CDMPW  ACPE),68,"PID88   ENTR     "); 
$END
      END  #ENTR# 
      CPCI[0] = O"42";   #FILL ID#
      CPLI[0] = O"44";   #LINK ID#
     END  #OBJ# 
  
     ELSE 
       BEGIN
       IF NOT PLIN                 # IF O OPTION IS NOT SELECTED       #
       THEN 
         BEGIN
         IF LMAP OR LXREF          # BUT R OR X IS SELECTED            #
         THEN 
           BEGIN
           GOTO CF070;             # CONTINUE AT CF070                 #
           END
         ELSE 
  
           BEGIN
           RETURN;                 # ELSE RETURN TO INIT40             #
           END
         END
       END
  
#*******************************************************************# 
PID90:  
#*******************************************************************# 
#*******************************************************************# 
     SWITCH   SWPTYP:QTYPE
             PRS204:NULL, 
             PRS202:IGR,
             PRS203:REAL, 
             PRS203:DBL,
             PRS204:BOOL, 
             PRS202:STTS, 
             PRS209:EBCD, 
             PRS202:USI,
             PRS208:HLTH, 
             PRS202:FIX,
             PRS204:OCT,
             PRS204:QTYPE$, 
             PRS206:TRAN; 
#*******************************************************************# 
CF000:  
$BEGIN
#*#   CDMPW  ACPT),42,"CF000  TEXT      "); 
$END
     CPTR [0] = 0;   #CLEAR RELOC BITS# 
CF004:  
 IF NOT CIFB AND NOT CIFL THEN GOTO CF019;
      LTCFL(P<BCF>,CFN,CF019);     #LOCATE CF#
      CFX = 0;      #INIT CF INDEX# 
$BEGIN
#*#   CIFW  CDUMP(P<BCF>,CFN,"CF004  CF          ");
$END
CF010:  
      KOP = CFOP[CFX];   #CURRENT CF OPERATION# 
      IF KOP EQ S"CODE" THEN GOTO CF020;    #CODE ONLY# 
      IF KOP NE S"PRSF" THEN GOTO CF016;    #NO CODE/PRSF#
#*******************************************************************# 
#PRSF#
     DEF  PTXP
               #CPT[CTX] = IKK#;        #PRESET DATA TO TEXT# 
     DEF  POCTW 
               #(2*I)#;             #OCTAL WORD POSITION# 
     DEF  PDBLK 
               #FOR I = 1 STEP 1 UNTIL 6 DO CED[I] = BLKW#; 
PRS00:  
      CFX = CFX+1;       #INCR CF INDEX#
      IF CFX GQ CFN THEN
      BEGIN#E-O-CF BLOCK# 
 IF NOT CIFB AND NOT CIFL THEN GOTO CF018;
          LTCFL(P<BCF>,CFN,CF018); #LOCATE CF#
          CFX = 0;  #INIT CF INDEX# 
      END  #E-O-CF BLOCK# 
      KOP = CFOP[CFX];   #CURRENT CF OPERATION# 
      IF KOP NE S"PRSD" THEN GOTO CF014;    #E-O-PRSF#
      #ELSE PRSD# 
      CFC = CFWC[CFX];
      IST = CFST[CFX];   #SYMB TBL POINTER# 
      IJK = CFRA[CFX];   #CURRENT L#
      PTXTPN(IJK);   #CHECK LOCN,CURRENT L# 
      IF IST EQ IKKD THEN GOTO PRS10;    #SAME ARRAY/TABLE# 
     #ELSE NEW ENTRY# 
     IKKD = IST;
      IF IST EQ 0 THEN
      BEGIN#NO RL,TYPE,LABEL# 
          IF NOT PLIN THEN GOTO PRS10;  #NO LINE# 
          #ELSE LINE#    GOTO PRS04;
      END  #NO RL,TYPE,LABEL# 
      #ELSE  CHECK RL#
          IF CPTRL[0] NQ RLNO[IST] THEN 
          BEGIN #NEW RL NO.#
               PTXTPP;   #CHECK,PUT TEXT# 
               CPTRL[0] = RLNO[IST];
               IF NOT PLIN THEN GOTO PRS10;  #NO LINE#
               #ELSE  LINE# 
                    CENO[0] = CSL [CPTRL[0]]; 
                    PTLST(ACEN);
                    CENO[0] = BLKW; 
                    GOTO PRS02; 
               #END   LINE# 
          END   #NEW RL NO.#
          #ELSE SAME RL NO.#
              IF NOT PLIN THEN GOTO PRS10;  #NO LINE# 
              #ELSE  LINE#
PRS02:  
               IJ = LOCN[IST];
               PROCT(IJ,PLBO6,PLLOC);   #PUT LOCN#
               PDBLK;    #CLEAR LINE# 
               IF NOT NNAM[IST] THEN PTLAB(IST);
               IF IJ EQ CTXL THEN 
               BEGIN#NO OFFSET# 
                    IF CLAS[IST] EQ S"TABL" THEN GOTO PRS04; #TABLE#
                    #ELSE NOT TABLE#
                         ITYP = TYPE[IST];   #TYPE# 
                         GOTO PRS06;
                    #END  NOT TABLE#
               END  #NO OFFSET# 
               #ELSE  OFFSET(>0)# 
                    CEDM[0] = HBSS;     #"BSS"# 
                    IJ = CTXL-IJ;  #OFFSET# 
                    KW = WCEDO; #KK WORD,BIT INDEX# 
                    KB = 0; 
                    CVTOD(IJ);     #PUT OFFSET# 
                    PTLST(ACED);   #PUT BSS#
                    CED[WCEDL] = BLKW; CED[WCEDM] = BLKW; 
               #END   OFFSET(>0)# 
               #BEGIN TABLE/UNKNOWN#
PRS04:  
                    ITYP = S"NULL"; 
               #END   TABLE/UNKNOWN#
PRS06:  
               CEDM[0] = " DATA ";       #"DATA"# 
              #END   LINE#
          #END  SAME RL NO.#
      #END   CHECK RL#
PRS10:  
     IKK = CFD[CFX];
     IF POBJ THEN 
     BEGIN#OBJ# 
      PTXP;    #PRSF DATA TO TEXT TABLE#
      IF NOT PLIN THEN GOTO PRS30; #NO LINE#
     END  #OBJ# 
     #ELSE  LINE# 
               PROCT(IKK,0,57,1,0);  #PUT OCTAL#
               CEDO[0] = BLKW;     CEDO[1] = BLKW;     #CLEAR LINE# 
               CEDO[2] = BLKW;
               KW = WCEDO;
               GOTO SWPTYP[ITYP]; 
              #EBCD#
PRS209: 
               CEDO[0] = HH10H; 
               GOTO PRS207; 
              #HLTH#
PRS208: 
               CEDO[0] = HH10A; 
PRS207: 
               IF IKK LAN O"7777000000" EQ 0 THEN IKK = IKK+O"55000000";
               B<18,42>CEDO[0] = B< 0,42>IKK; 
               B< 0,18>CEDO[1] = B<42,18>IKK; 
               GOTO PRS20;
              #TRAN#
PRS206: 
               FOR I = 0 STEP 6 UNTIL LBYTP       DO
                    IF B<I,6>IKK NQ 0 THEN GOTO PRS205;  #NON-ZERO# 
               #ELSE TRAN ZERO# 
                    CEDO[0] = HH0;
                    GOTO PRS20; 
               #END  TRAN ZERO# 
               #EDIT OCTAL# 
PRS205: 
               CEDO[0] = HHB; 
               KB = 6;
               IJ = POCTW/WBITS;    #OCTAL WORD INDEX#
               IK = POCTW-IJ*WBITS; 
               FOR J = LOCTP STEP -3 UNTIL I DO 
               BEGIN#J# 
                    B<KB,6>CED[KW] = B<IK,6>CEDOC[IJ];
                    IF IK EQ LBYTP THEN 
                    BEGIN#E-O-WORD# 
                         IK = 0;
                         IJ = IJ+1; 
                    END  #E-O-WORD# 
                    ELSE IK = IK+6;     #NOT E-O-WORD#
                    IF KB EQ LBYTP THEN 
                    BEGIN#E-O-WORD# 
                         KB = 0;
                         KW = KW+1; 
                    END  #E-O-WORD# 
                    ELSE KB = KB+6;     #NOT E-O-WORD#
               END  #J# 
               GOTO PRS20;
              #OCT# 
PRS204: 
               FOR I = 0 STEP 3 UNTIL LBYTP       DO
                    IF B<I,3>IKK NQ 0   THEN GOTO PRS205;  #>7 #
               #</= 7#
                    B<0,6>CEDO[0] = IKK+HZERO;
                    GOTO PRS20; 
              #REAL#
PRS203: 
               CEDO[0] = CEDOC[0];
               CEDO[1] = CEDOC[1];
               CEDO[2] = HHB; 
               GOTO PRS20;
              #IGR,USI,FIX# 
PRS202: 
               KB = 0;
               CVRTD(IKK);    #CONVERT TO DECIMAL#
PRS20:  
               PTLOC;    #PUT LOCN# 
               PTLST(ACED);   #PUT LINE#
               CED[WCEDL] = BLKW;  CED[WCEDM] = "     DATA "; 
     #END   LINE# 
PRS30:  
      PTXTPI;  #INCR,CHECK OVERFLOW#
      CFX = CFX+1;  #INCR CF POINTER# 
      CFC = CFC-1;  #DECR WC# 
      IF CFC LQ 0 THEN GOTO PRS00; #E-O-DATA# 
      #ELSE MORE DATA#   GOTO PRS10;
#*******************************************************************# 
#E-O-PRSF/NO PRSF/CODE# 
CF014:  
      IF KOP EQ S"TERM" THEN
          BEGIN#TERM# 
               CFX = CFX+1;   #INCR CF INDEX# 
               IF CFX LS CFN THEN GOTO CF010;     #NOT E-O-CF BLOCK#
               #ELSE E-O-CF BLOCK#
                    GOTO CF004; 
               #END  E-O-CF BLOCK#
          END  #TERM# 
      #ELSE NOT TERM# 
CF016:  
$BEGIN
#*#   CDMPW  CFX ),3 ,"CF016  CFX       "); 
#*#   CDMPW  SLCX),30,"CF016  SLCX      "); 
$END
#***#  GOTO CF020;
  #*** INVALID CF ENTRY ***#
CF017:  
#*** NO PRSF/CODE***# 
CF018:  
  #*** TERM OMITTED ***#
CF019:  
      KOP = S"TERM";    #FORCE E-O-PROG#
#*******************************************************************# 
     SWITCH   SWCTYP:QTYPE
             CON204:NULL, 
             CON202:IGR,
             CON203:REAL, 
             CON203:DBL,
             CON204:BOOL, 
             CON202:STTS, 
             CON209:EBCD, 
             CON202:USI,
             CON208:HLTH, 
             CON202:FIX,
             CON204:OCT,
             CON204:QTYPE$, 
             CON206:TRAN; 
#*******************************************************************# 
CF020:  
$BEGIN
#*#   CDMPW  ACPT),42,"CF020  TEXT      "); 
$END
      IF CPTRL[0] NQ RLP THEN 
      BEGIN#NOT PROG RL NO.#
          CTXL = LDSPL;  #CURRENT L#
          PTXTPP;        #PUT TEXT# 
          CPTRL[0] = RLP;     #RL NO.#
          IF PLIN THEN PTLST(ACEN);     #LINE#
      END  #NOT PROG RL NO.#
#*******************************************************************# 
      IF LPLC EQ 0 THEN GOTO CF030;     #NO CNST# 
#CNST#
     DEF PTCON
               #CPT[CTX]=IKK#;                #PUT CNST#
     DEF  PRCON 
               #PROCT(IKK,0,57,1,0)#;  #PUT  OCTAL CNST#
          PTXTPN(LDSPL);      #CHECK LOCN,CURRENT L#
          IST  = BABY[LPLC];  #CNST ENTRY#
          CED[WCEDM] = "     DATA ";
CON00:  
          IF IST  EQ 0 THEN GOTO CF030; #E-O-CNST#
          #ELSE CNST# 
               ITYP = TYPE[IST];   #TYPE# 
               FIND(IST,NP);  #FIND VALUE#
               IF ITYP EQ S"DBL" THEN IC = 10;    #DBL-NCHR=10# 
               ELSE IC = NCHR[NP];      #NOT DBL# 
CON02:  
               IKK = CONS[NP];     #CNST# 
               IF POBJ THEN 
               BEGIN#OBJ# 
                    PTCON;    #PUT CNST#
                    IF NOT PLIN THEN GOTO CON30;  #NO LINE# 
               END  #OBJ# 
          #ELSE LINE# 
               PTLOC;    #LOCATION# 
               CEDO[0] = BLKW;     CEDO[1] = BLKW;     #CLEAR LINE# 
               CEDO[2] = BLKW;
               PRCON;    #PUT OCTAL#
               KW = WCEDO;
               GOTO SWCTYP[ITYP]; 
              #EBCD#
CON209: 
               CEDO[0] = HH10H; 
               GOTO CON207; 
              #HLTH#
CON208: 
               IF NBYT[IST] GQ WBYT THEN GOTO CON209; #10L# 
               CEDO[0] = HH10A; 
CON207: 
               IF IKK LAN O"7777000000" EQ 0 THEN IKK = IKK+O"55000000";
               B<18,42>CEDO[0] = B< 0,42>IKK; 
               B< 0,18>CEDO[1] = B<42,18>IKK; 
               GOTO CON20;
              #TRAN#
CON206: 
               IF NBYT[IST] GQ WBYT THEN GOTO CON203; #FULL WORD# 
               FOR I = 0 STEP 6 UNTIL LBYTP       DO
                    IF B<I,6>IKK NQ 0 THEN GOTO CON205;  #NON-ZERO# 
               #ELSE TRAN ZERO# 
                    CEDO[0] = HH0;
                    GOTO CON20; 
               #END  TRAN ZERO# 
               #EDIT OCTAL# 
CON205: 
               CEDO[0] = HHB; 
               KB = 6;
               IJ = POCTW/WBITS;    #OCTAL WORD INDEX#
               IK = POCTW-IJ*WBITS; 
               FOR J = LOCTP STEP -3 UNTIL I DO 
               BEGIN#J# 
                    B<KB,6>CED[KW] = B<IK,6>CEDOC[IJ];
                    IF IK EQ LBYTP THEN 
                    BEGIN#E-O-WORD# 
                         IK = 0;
                         IJ = IJ+1; 
                    END  #E-O-WORD# 
                    ELSE IK = IK+6;     #NOT E-O-WORD#
                    IF KB EQ LBYTP THEN 
                    BEGIN#E-O-WORD# 
                         KB = 0;
                         KW = KW+1; 
                    END  #E-O-WORD# 
                    ELSE KB = KB+6;     #NOT E-O-WORD#
               END  #J# 
               GOTO CON20;
              #OCT# 
CON204: 
               FOR I = 0 STEP 3 UNTIL LBYTP       DO
                    IF B<I,3>IKK NQ 0   THEN GOTO CON205;  #>7 #
               #</= 7#
                    B<0,6>CEDO[0] = IKK+HZERO;
                    GOTO CON20; 
              #REAL#
CON203: 
               CEDO[0] = CEDOC[0];
               CEDO[1] = CEDOC[1];
               CEDO[2] = HHB; 
               GOTO CON20;
              #IGR,USI,FIX# 
CON202: 
               KB = 0;
               CVRTD(IKK);    #CONVERT TO DECIMAL#
CON20:  
               PTLST(ACED);   #PUT LINE#
          #END  LINE# 
CON30:  
          PTXTPI;   #INCR,CHECK TEXT OVERFLOW#
          IF IC LQ 10 THEN GOTO CON34;
          #ELSE MULTI-WORD# 
               NP = NP+1; 
               IC = IC-10;
               GOTO CON02;
          #END  MULTI-WORD# 
CON34:  
          IST = ASEQ[IST];    #NEXT CNST# 
          GOTO CON00; 
          #END  CNST# 
#*******************************************************************# 
#ADCN#
     DEF  PRVFD 
               #CEDM[0]=" VFD      "#;       #PUT "VFD"#
     DEF PRO30
               #CEDO[0]="30/       "#;  #PUT "30/"# 
     DEF  PRO60 
               #CEDO[0]="60/0      "#;       #PUT "60/0"# 
     DEF  PRZO1 
               #CED[1]=ZEROW#;     #ZERO OCTAL - 1ST HALF # 
     DEF  PRZO2 
               #CED[2]=ZEROW#;     #ZERO OCTAL - 2ND HALF # 
CF030:  
$BEGIN
#*#   CDMPW  ACPT),42,"CF030  TEXT      "); 
$END
      IF APLC EQ 0 THEN GOTO CF040;  #NO ADCN#
#*******************************************************************# 
      #ELSE ADCN# 
          BABX = BABY[APLC];
          PTXTPN(ADSPL);      #CHECK LOCN,CURRENT L#
          IF PLIN THEN
          BEGIN#LINE# 
               CEDO[0] = BLKW;     CEDO[1] = BLKW;     #CLEAR LINE# 
               CEDO[2] = BLKW;
               PTLOC;    #LOCATION# 
          END  #LINE# 
          IOP = ADCNS;        #ADCN CODE# 
ADC10:  
          IF BABX EQ 0 THEN GOTO CF040; #E-O-ADCN#
          #ELSE ADCN# 
          IKK = DSPL[BABX]; 
          IF POSI[BABX] EQ S"NULL" THEN                 #ZERO#
          BEGIN#NULL# 
               IST = 0;       #ABS IND# 
               TXPX = 3;
               GOTO COD84;
          END  #NULL# 
         #ELSE RELOC# 
          TXPX = POSI[BABX]+2; #RELOC POSITION# 
          IST = ALNK[BABX];   #ADDR#
          IF TXPX NQ 6 THEN GOTO COD84; 
          #ELSE ALL#
             IKKT = IKK;
                   B<0,CNAM*6>IKKT=INVR[BABX];
             GOTO COD89;
          #END  ALL#
         #END  RELOC# 
ADC30:  
      BABX = ASEQ[BABX];      #ADCN LINK# 
      GOTO ADC10; 
          #END  ADCN# 
      #END  ADCN# 
#*******************************************************************# 
CF040:  
$BEGIN
#*#   CDMPW  ACPT),42,"CF040  TEXT      "); 
$END
      IOP = KOP;         #CURRENT CF OPERATION# 
      TXPX = 0;      #RELOC POSITION# 
      PTXTPN(CDSPL);          #CHECK LOCN,CURRENT L#
          IF PLIN THEN
          BEGIN#LINE# 
               PTLOC;    #LOCATION# 
               PRBLK;              #CLEAR LINE# 
          END  #LINE# 
#CODE#
     DEF  PTXQ
               #B<CTXQ,15>CPT[CTX] = IJK#;   #OP,I,J,K# 
     DEF  PTXR
               #B<CTXR,4>CPTR[0]=B<CTXR,4>CPTR[0]+TXP[TXPX]#;#RELOC BIT#
     DEF  PTXK1 
               #B<27,18>CPT[CPTX]=IKKT#;  #PUT K[1]#
     DEF  PTXK2 
               #B<42,18>CPT[CPTX]=IKKT#; #PUT K[2]# 
#*******************************************************************# 
     DEF  EDXO
               #O"3033"#;     #"X0"#
     DEF  EDAO
               #O"0133"#;     #"A0"#
     DEF  EDBO
               #O"0233"#;     #"B0"#
     DEF  EDXOP 
               #O"303345"#;   #"X0+"# 
     DEF  EDAOP 
               #O"013345"#;   #"A0+"# 
     DEF  EDBOP 
               #O"023345"#;   #"B0+"# 
     DEF  EDXOC 
               #O"303356"#;   #"X0,"# 
     DEF  EDBOC 
               #O"023356"#;   #"B0,"# 
     DEF  EDPBO 
               #O"450233"#;   #"+B0"# 
     DEF  EDMBO 
               #O"460233"#;   #"-B0"# 
     DEF  EDPXO 
               #O"453033"#;   #"+X0"# 
     DEF  EDMXO 
               #O"463033"#;   #"-X0"# 
     DEF  EDTXO 
               #O"473033"#;   #"*X0"# 
     DEF  EDDXO 
               #O"503033"#;   #"/X0"# 
     DEF  EDCXO 
               #O"563033"#;   #",X0"# 
     DEF COD1X
               #COD64#;           #1 WORD CF BRANCH#
     SWITCH SWCFOP
               COD131,        #NULL#
               COD13,COD13,COD13,COD13,COD13,COD13,COD13,COD13, #XJ,KK# 
               COD161,                  #KK  BI,BJ,KK  BI,KK# 
               COD16,                   #    BI,BJ,KK  BI,KK# 
               COD162,COD162,           #    BI,BJ,KK  BI,KK  BJ,KK#
               COD132,COD132,           #BJ+K#
               COD15,                   #KK#
               COD130,                  #KK  BI+KK# 
               COD15,         #PS#
               COD182,COD182,COD182,    #KK  BJ+KK# 
               COD183,COD183,COD183,    #    AJ+KK# 
               COD181,COD181,COD181,    #    XJ+KK# 
               COD58,                   #  #
               COD561,COD561,COD561,COD561,COD561, #XJ+BK#
               COD562,COD562,COD562,COD562,COD562, #XJ-BK#
               COD563,COD563,COD563,COD563,        #XJ*BK#
               COD564,COD564,                      #XJ/BK#
               COD56,                   #XJ#
               COD423,COD423,COD423,    #XJ   XJ+BK#
               COD421,COD421,COD421,    #AJ   AJ+BK#
               COD44,COD44,COD44,       #     AJ-BK#
               COD422,COD422,COD422,    #BJ   BJ+BK#
               COD46,COD46,COD46,       #-BK  -BK+BJ# 
               COD51,                   #-XK# 
               COD502,COD501,COD500,    #-XK (+/-/*)XJ# 
               COD53,                   #XK#
               COD52,COD52,COD52,       #XK   BJ,XK#
               COD54,COD54,COD54,       #     BJ,XK#
               COD48,COD48,COD48,       #JK#
               COD56,COD56,             # RXJ , WXJ #                    LARRY-R
               COD70,COD74,        #LABL,CNTL#
               COD82,COD80,        #PRSD,PRSC#
               COD87,         #MMDDY HHMM#
               COD78, 
               COD90,COD94,        #RMRK,CMNT#
               CF058,COD1X,CF060,  #IDENTIFIERS,TERMINATOR# 
               COD96,              #LINE# 
               COD76,COD88,        #TRACE#
               COD133,     #TRB-TRJ#
               CF058;              #E-O-SWITCH# 
                # BASED PROG  XTRN #
     SWITCH SWRLNO  COD02,COD03,COD30;
     SWITCH SKKP    COD05,COD06,COD07,
                    COD05,COD06,COD07,COD07;      #ADCN#
     SWITCH    SWOIJ     COD120,COD121,COD122,  #OP I,J AND KK[I]#
                         COD113,COD112,COD111,COD114;  # ADCN#
     SWITCH  SWRTYP:QTYPE 
             COD204:NULL, 
             COD202:IGR,
             COD203:REAL, 
             COD203:DBL,
             COD204:BOOL, 
             COD202:STTS, 
             COD209:EBCD, 
             COD202:USI,
             COD208:HLTH, 
             COD202:FIX,
             COD204:OCT,
             COD204:QTYPE$, 
             COD206:TRAN; 
#*******************************************************************# 
COD00:  
      IF IOP GQ S"LABL" THEN GOTO SWCFOP[IOP]; #NOT INSTR#
      #ELSE 15/30-BIT INSTR.# 
          IF IOP GQ S"RXJ" THEN                                          LARRY-R
             # DIRECT LCM ACCESS - WHERE  RESULT OPERAND IS J            LARRY-R
                                 -        INPUT OPERAND IS  K         #  LARRY-R
            BEGIN                                                        LARRY-R
            CFK[CFX]=CFJ[CFX];       #FIDDLE  IT  #                      LARRY-R
            CFJ[CFX]=CFI[CFX];                                           LARRY-R
            CFI[CFX]= 0;                                                 LARRY-R
            END                                                          LARRY-R
          IJK = COP[IOP]+CFIJK[CFX];    #OP,I,J,K # 
          IF POBJ THEN PTXQ;  #PUT OP,I,J,K#
          IF IOP GQ S"NOP" THEN GOTO COD40; 
#*******************************************************************# 
     #30-BIT INSTR.#
          IKK = CFKK[CFX];#K FIELD# 
          IST = CFST[CFX];#SYMB TABL POINTER# 
          IF IST EQ 0 THEN
          BEGIN#ABS#
               IKKT = IKK;
             IF NOT POBJ THEN GOTO COD10;    #NO OBJ# 
             #OBJ BEGIN#
               CTXQ = CTXQ+15;     #INCR Q INDEX# 
               B<CTXQ,15>CPT[CTX] = IKKT;    #PUT LOWER K#
               CTXQ = CTXQ+15;     #INCR Q INDEX# 
               GOTO COD09;
             #OBJ END#
          END  #ABS#
          IF IST EQ 1 THEN
          BEGIN#LOC CTR#
               IKKT = IKK+CTXL;    #K = CURRENT L+OFFSET# 
               GOTO COD03;
          END  #LOC CTR#
          #ELSE NAME# 
COD01:  
          IF UNDEC[IST] OR CLAS[IST] EQ S"DUMY" 
           THEN  # THIS K AINT PROPERLY DEFINED#
           BEGIN
            LOCN[IST] = O"400000" + CTXL; 
            RLNO[IST] = 1 ; 
           END
               IKKT = IKK+LOCN[IST];    #K = OFFSET+LOCN# 
               IRL = RLNO[IST];   #RL NO.#
               IF IRL LS 3 THEN GOTO SWRLNO[IRL]; #NOT COMMON#
               ELSE GOTO COD36;    #COMMON# 
               #BASED#
COD02:  
                  IF NOT POBJ THEN GO TO COD10;   #NO OBJ#
                  GOTO COD04;  #OBJ#
               #PROG. RELOC.# 
COD03:  
                  CEDR0 = HBPLS;   #RELOC CHAR# 
                  IF NOT POBJ THEN GO TO COD10;   #NO OBJ#
                  #OBJ  BEGIN # 
                    PTXR;     #PROG RELOC. FLAG#
               #PUT RELOC.# 
COD04:  
                    GOTO SKKP[TXPX]; #PUT K[I]# 
                    #K[0]#
COD05:  
                         B<12,18>CPT[CPTX] = IKKT; #PUT K[0]# 
                         GO TO COD08; 
                    #K[1]#
COD06:  
                         PTXK1;    #PUT K[1]# 
                         GOTO COD08;
                    #K[2]#
COD07:  
                         PTXK2;    #PUT K[2]# 
COD08:  
          CTXQ = CTXQ+30;#INCR Q INDEX# 
          #TEXT,FILL,LINK COMPLETE# 
COD09:  
                  #OBJ  END#
     DEF  PLOIJ0
               #PLOCT(IJK , 45,54, 1, 0)#;       #PUT OP,I,J[0]#
     DEF  PLOIJ1
               #PLOCT(IJK , 45,54, 1,30)#;       #PUT OP,I,J[1]#
     DEF  PLOIJ2
               #PLOCT(IJK , 45,54, 2, 0)#;       #PUT OP,I,J[2]#
     DEF  PLKK0 
               #PLOCT(IKKT,42,57, 1,24)#;      #PUT KK[0]#
     DEF  PLKK1 
               #PLOCT(IKKT,42,57, 1,54)#;      #PUT KK[1]#
     DEF  PLKK2 
               #PLOCT(IKKT,42,57, 2,24)#;      #PUT KK[2]#
COD10:  
     IF NOT PLIN THEN GOTO COD29;            #NO LINE#
     #ELSE LINE#
          KW = WOPND; #KK WORD,BIT INDEX# 
          KB = 0; 
          GOTO SWOIJ [TXPX];
      #ALL Q[2]#
COD114: 
          PLKK2;    #PUT KK[2]# 
          KW = WOPND+1;       #WORD INDEX#
          KB = 36;
          GOTO COD11; 
      #Q[0]#
COD113: 
          PRO30;    #PUT  30/#
          PLKK0;    #PUT KK[0]# 
          GOTO COD110;
      #Q[1]#
COD112: 
          PLKK1;    #PUT KK[1]# 
          GOTO COD110;
      #Q[2]#
COD111: 
          PLKK2;    #PUT KK[2]# 
COD110: 
          KB = 18;
COD11:  
          CEDR2 = CEDR0;  #RELOC CHAR#
          GOTO COD20; 
      #Q[2]#
COD122: 
          CEDR2 = CEDR0; #RELOC CHAR[2]#
          PLOIJ2;   #PUT OP,I,J[2]# 
          PLKK2;    #PUT KK[2]# 
          GOTO COD12; 
      #Q[1]#
COD121: 
          CEDR1 = CEDR0; #RELOC CHAR[1]#
          PLOIJ1;   #PUT OP,I,J[1]# 
          PLKK1;    #PUT KK[1]# 
          GOTO COD12; 
      #Q[0]#
COD120: 
          CEDR = CEDR0;  #RELOC CHAR[2]#
          PLOIJ0;   #PUT OP,I,J[0]# 
          PLKK0;    #PUT KK[0]# 
COD12:  
          GOTO SWCFOP[IOP];   #MNEMONIC,I/J#
      #TRB-TRJ# 
COD133: 
               CEDO[0] = "12/       ";  #PUT "12/"# 
               PRVFD;     #PUT "VFD"# 
               KB = 18;  #BIT INDEX#
               CVTOD(CFML[CFX]);   #LINE NO#
               IF KB EQ 36 THEN 
               BEGIN#NEXT WORD# 
                    B<42,18>CEDO[0] = O"563443";   #",18/"# 
                    CEDO[1] = "/         "; 
               END  #NEXT WORD# 
               ELSE B<KB+6,24>CEDO[0] = O"56344350"; #",18/"# 
               KB = KB+30;         #INCR BIT INDEX# 
               IF KB LS WBITS THEN GOTO COD20; #NOT E-O-WORD# 
               #ELSE NEXT WORD# 
                    KB = KB-WBITS;      #ADJUST BIT,WORD INDEXEX# 
                    KW = WOPND+1; 
                    GOTO COD20; 
               #END  NEXT WORD# 
     #BJ+K# 
COD132: 
          CEDOJP = CFJ[CFX]*64+EDBOP;   #BJ+# 
          GOTO COD14; 
      #30/# 
COD131: 
          PRO30;    #PUT "30/"# 
          GOTO COD14; 
      #(BJ+)KK# 
COD130: 
# #      IF CFI[CFX] EQ 0 THEN GOTO COD15; #KK# 
         #BJ+KK#
##         CEDOJP = CFI[CFX]*64 + EDBOP;    #BI+# 
          GOTO COD14; 
     #XJ,KK#
COD13:  
          CEDOJP = CFJ[CFX]*64+EDXOC;      #XJ,#
COD14:  
          KB = 18;  #KK BIT INDEX#
COD15:  
          CEDM [0] = CMN[IOP]; #MNEMONIC# 
          GOTO COD20; 
     #(BI,)(BJ,)KK# 
COD162: 
          IF CFI[CFX] NQ 0 THEN GOTO COD16;  #BI,(BJ,)KK# 
          IF CFJ[CFX] EQ 0 THEN GOTO COD17;  #B0,KK#
         #ELSE BJ,KK# 
          CEDOJP = CFJ[CFX]*64+EDBOC;      #BJ,#
          IOP = IOP + 65  ;    # LE/GT  INDEX   #                        LARRY-R
          GOTO COD14; 
         #END  BJ,KK# 
     #(BI,(BJ,))KK# 
COD161: 
          IF CFIJ[CFX] EQ 0 THEN GOTO COD15; #KK# 
     #BI,(BJ,)KK# 
COD16:  
          IF CFJ[CFX] NQ 0 THEN 
     #BI,BJ,KK# BEGIN 
          CEDOKJ[0] = CFJ[CFX]*64+EDBOC;    #BJ,# 
          KB = 36;  #KK BIT INDEX#
     #BI,BJ,KK# END 
     #BI,KK# ELSE 
COD17:  
          KB = 18;  #KK BIT INDEX#
          CEDOJP = CFI[CFX]*64+EDBOC;      #BI,#
          GOTO COD15; 
     #AJ+KK#
COD183: 
          CEDOJP = CFJ[CFX]*64+EDAOP;      #AJ+#
          GOTO COD18; 
     #(BJ+)KK#
COD182: 
          IF CFJ[CFX] EQ 0 THEN GOTO COD19;  #KK# 
         #BJ+KK#
          CEDOJP = CFJ[CFX]*64+EDBOP;      #BJ+#
          GOTO COD18; 
     #XJ+KK#
COD181: 
          CEDOJP = CFJ[CFX]*64+EDXOP;      #XJ+#
COD18:  
          KB = 18;  #KK BIT INDEX#
     #OPI#
COD19:  
          CEDM[0] = CMN[IOP];      #MNEMONIC# 
          CEDMI[0] = CFI[CFX]+HZERO;  #--I# 
     #KK# 
COD20:  
          IF IST EQ 0 THEN GOTO COD24;  #ABS VALUE# 
          CEDR0 = HBLK2;
          IF IST EQ 1 THEN
          BEGIN#LOC CTR#
               B<KB,6>CED[KW] = HAST;   #"*"# 
               KB = KB+6;     #INCR BIT INDEX#
               GOTO COD22;
          END  #LOC CTR#
          IF CLAS[IST] EQ S"CONS" THEN
          BEGIN#CNST# 
               FIND(IST,NP);  #FIND CNST# 
               GOTO SWRTYP[TYPE[IST]];
              #EBCD#
COD209: 
               IK = HH;       #"H"# 
               GOTO COD207; 
              #HLTH#
COD208: 
               IF NCHR[NP] GQ WBYT THEN GOTO COD209;   #"H"#
               #ELSE < FULL WORD #
               IK = HA;       #"A"# 
COD207: 
               B<KB,18>CED[KW] = HEQ10;      #"=10"#
               KB = KB+18;    #INCR BIT INDEX#
               B<KB, 6>CED[KW] = IK;         #"H"/"A"#
               NP = NP+IKK;   #OFFSET#
               FOR I = 0 STEP 6 UNTIL LBYTP DO
               BEGIN#I# 
                 IF KB EQ LBYTP THEN
                 BEGIN#E-O-WORD#
                   KW = KW+1; 
                    KB = 0; 
                 END  #E-O-WORD#
                 ELSE KB = KB+6;   #NOT E-O-WORD# 
                 IF B<I,6>CONS[NP] NQ 0 THEN
                 #NON-ZERO# 
                    B<KB,6>CED[KW] = B<I,6>CONS[NP];
                 #ELSE ZERO - " "#
               END  #I# 
               GOTO COD28;
              #TRAN#
COD206: 
               I = NCHR[NP];       #NCHR# 
               NP = NP+IKK;        #OFFSET# 
               IF I GQ WBYT THEN GOTO COD203;     #FULL WORD# 
               #ELSE < FULL WORD #
               IJ  = CONS[NP];     #CNST# 
               FOR I = 0 STEP 6 UNTIL LBYTP       DO
                    IF B<I,6>IJ NQ 0 THEN GOTO COD205;  #NON-ZERO#
               #ELSE TRAN ZERO# 
                    B<KB,12>CED[KW] = HEQ0;       #"=0"#
                    GOTO COD28; 
               #END  TRAN ZERO# 
               #EDIT OCTAL# 
COD205: 
               B<KB,12>CED[KW] = HEQB;       #"=B"# 
               KB = KB+12;    #INCR BIT INDEX#
               PROCT(IJ,I,LOCTP,KW,KB);      #PUT OCTAL#
               GOTO COD28;
              #OCT# 
COD204: 
               IJ  = CONS[NP];     #CNST# 
               FOR I = 0 STEP 3 UNTIL LBYTP       DO
                    IF B<I,3>IJ NQ 0   THEN GOTO COD205;  #>7 # 
               #</= 7#
                    B<KB,12>CED[KW] = HEQ0+IJ;    #"=N"#
                    GOTO COD28; 
              #REAL#
COD203: 
               B<KB,12>CED[KW] = HEQB;       #"=B"# 
               KB = KB+12;    #INCR BIT INDEX#
               PROCT(CONS[NP],0,57,KW,KB);        #PUT OCTAL# 
               GOTO COD28;
              #IGR,USI,FIX# 
COD202: 
               B<KB,6>CED[KW] = HEQ;    #"="# 
               KB = KB+6;     #INCR BIT INDEX#
               CVRTD(CONS[NP]);  #CONVERT TO DECIMAL# 
               GOTO COD28;
          END  #CNST# 
          #ELSE NAME# 
             IF NNAM[IST] THEN
             BEGIN#INTL#
COD21:  
               B<KB,6>CED[KW] = HG;     #"G"# 
               IF KB EQ LBYTP THEN
               BEGIN#E-O-WORD#
                    KB = 0;   KW = KW+1;     #INCR WORD INDEX#
               END  #E-O-WORD#
               ELSE KB = KB+6;     #INCR BIT INDEX# 
               PROCT(LOCN[IST],GOCTP,LOCTP,KW,KB); #PUT (G)LOCN#
               KB = KB+36;         #INCR BIT INDEX# 
               IF KB LS WBITS THEN GOTO COD22; #NOT E-O-WORD# 
               #ELSE  E-O-WORD# 
                    KB = KB-WBITS;      #ADJ BIT INDEX# 
                    KW = KW+1;
                    GOTO COD22; 
               #END   E-O-WORD# 
             END  #INTL#
            #ELSE USER LABEL# 
               FIND(IST,NP);  #FIND NAME# 
               I = 0;    #NAME BIT INDEX# 
               FOR J = NCHR[NP] STEP -1 UNTIL 1 DO
               BEGIN #I#
                    IF KB EQ WBITS THEN 
                    BEGIN #E-O-WORD#
                         KB = 0;
                         KW = KW+1; 
                         IF KW EQ 10 THEN GOTO COD22;  #E-O-LINE# 
                    END   #E-O-WORD#
                    B<KB,6>CED[KW] = B<I,6>NAM1[NP];
                    IF I  EQ LBYTP THEN 
                    BEGIN #E-O-NAME WORD# 
                         I = 0; 
                         NP = NP+1; 
                    END   #E-O-NAME WORD# 
                    ELSE I = I+6;  #INCR BIT INDEX# 
                    KB = KB+6;     #INCR BIT INDEX# 
               END  #I# 
            #END  USER LABEL# 
          #END  NAME# 
COD22:  
          IF IKK  EQ 0 THEN GOTO COD28; #NO OFFSET# 
          IF IKK LS 0 THEN GOTO COD24; #NEGATIVE# 
          #POSITIVE#
               IF KB EQ WBITS THEN
               BEGIN #E-O-WORD# 
                    KB = 0; 
                    KW = KW+1;
               END   #E-O-WORD# 
               B<KB,6>CED[KW] = HPLUS;  #"+"# 
               KB = KB+6;     #INCR BIT INDEX#
     #ABS VALUE#
COD24:  
          CVTOD(IKK); #OFFSET/ABS VALUE#
COD28:  
          PTLST(ACED);    #PUT LINE#
          PRBLK;    #CLEAR LINE#
          CED0[0] = BLKW;     #CLEAR LINE NO.#
     #END  LINE#
COD29:  
          TXPX = TXPX+2; #INCR RELOC. POSITION INDEX# 
          GOTO COD60; 
#*******************************************************************# 
                     #XTRN# 
COD30:  
                       CEDR0 = HBX; #RELOC CHAR#
                       IF NOT POBJ THEN GOTO COD10;#NO OBJ# 
                       #OBJ BEGIN#
                         IFLC = CTXL+FLP[TXPX];   #1,P,RL,LOC#
                        IF CLAS[IST] NQ S"TITM" THEN IJ = IST;
                         ELSE IJ = MAMA[IST];     #TABLE ITEM#
                         IF IJ NQ CPLL THEN 
                         BEGIN#NEW XTRN#
                              IF CPLB THEN CPLX = CPLX+1; 
                              CPLL = IJ;     #CURRENT XTRN# 
              FIND(IJ,NMX); 
                             CPL [CPLX] = 0;     #CLEAR#
                              CPLN[CPLX] = NAM1[NMX];  #XTRN NAME#
                              IF NCHR[NP] LS CNAM THEN #"0" FILL #
                               FOR I = NCHR[NP]*6 STEP 6 UNTIL BNAM DO
                                B<I,6>CPLN[CPLX] = BLK6;
      IF XTRN[IJ] EQ S"WEAK" THEN CPLW[CPLX] = 1; 
#     IF EXTERNAL IS WEAK- SET FLAG                                    #
                              CPLX = CPLX+1; #INCR LINK INDEX#
                              GOTO COD32; 
                         END  #NEW XTRN#
                         #ELSE - SAME XTRN# 
                              IF CPLB THEN
                              BEGIN#2ND HALF# 
                                   CPL1[CPLX] = IFLC;  #LOWER BYTE# 
                                   CPLX = CPLX+1; #INCR LINK INDEX# 
                                   CPLB = FALSE;  #LOWER 2ND HALF FLAG# 
                                   GOTO COD33;
                              END  #2ND HALF# 
                              #ELSE 1ST HALF# 
COD32:  
                                   CPL[CPLX] = 0; #CLEAR# 
                                   CPL0[CPLX] = IFLC;  #UPPER#
                                   CPLB = TRUE;  #RAISE  2ND HALF FLAG# 
                              #END  1ST HALF# 
                         #END  - SAME XTRN# 
COD33:  
                         IF CPLX LS ECPL THEN GOTO COD04; 
                         #ELSE  LINK# 
                              PTLNK;    #PUT LINK#
                              CPLX = 1; #INIT LINK INDEX# 
                              CPLL = 0; #INIT LAST XTRN#
                              GOTO COD04; 
                         #END   LINK# 
                       #OBJ END#
                    #COMMON#
COD36:  
                       CEDR0 = HBC; #RELOC CHAR#
                       IF NOT POBJ THEN GOTO COD10;#NO OBJ# 
                       #OBJ BEGIN#
                         IFLC = CTXL+FLP[TXPX];   #1,P,RL,LOC#
                         IF CPFL NQ IRL THEN
                         BEGIN#NEW AR#
                              CPFL = IRL;         #CURRENT AR#
                              IF CPFB THEN
                              BEGIN#2ND HALF# 
                                   CPF1[CPFX] = CPFL;  #AR TO LOWER#
                                   CPFX = CPFX+1; #INCR FILL INDEX# 
                                   GOTO COD38;
                              END  #2ND HALF# 
                              #ELSE 1ST HALF# 
                                   CPF[CPFX] = CPFL;   #AR TO UPPER#
                                   GOTO COD37;
                              #END  1ST HALF# 
                         END  #NEW AR#
                         #ELSE - OLD AR#
                              IF CPFB THEN
                              BEGIN#2ND HALF# 
                                   CPFB = FALSE;  #LOWER 2ND HALF FLAG# 
COD37:  
                                   CPF1[CPFX] = IFLC;  #1,P,RL,LOC# 
                                   CPFX = CPFX+1; #INCR FILL INDEX# 
                                   GOTO COD39;
                              END  #2ND HALF# 
                              #ELSE 1ST HALF# 
                                   CPFB = TRUE;   #RAISE 2ND HALF FLAG# 
COD38:  
                                   CPC[CPFX] = 0; 
                                   CPF[CPFX] = IFLC;   #1,P,RL,LOC# 
                              #END  1ST HALF# 
                         #END - OLD AR# 
COD39:  
                         IF CPFX LS ECPF THEN GOTO COD04; 
                         #ELSE  FILL# 
                              PTFIL;    #PUT FILL#
                              CPFX = 1; #INIT FILL INDEX# 
                              CPFL = 0; #INIT LAST AR#
                              GOTO COD04; 
                         #END   FILL# 
                       #OBJ END#
#*******************************************************************# 
#*******************************************************************# 
     #15-BIT INSTR# 
     DEF  PLIJK0
               #PLOCT(IJK,45,57,1, 0)#;      #PUT OP I,J,K[0]#
     DEF  PLIJK1
               #PLOCT(IJK,45,57,1,30)#;      #PUT OP I,J,K[1]#
     DEF  PLIJK2
               #PLOCT(IJK,45,57,2, 0)#;      #PUT OP I,J,K[2]#
     DEF  PLIJK3
               #PLOCT(IJK,45,57,2,30)#;      #PUT OP I,J,K[3]#
     SWITCH SWOIJK  COD410,COD411,COD412,COD413;
COD40:  
          CTXQ = CTXQ+15;     #INCR Q COUNT#
        IF NOT PLIN THEN GOTO COD59;    #NO LINE# 
        #LINE BEGIN#
#*#  CIFY BEGIN 
          IF IOP EQ S"NOP" THEN 
          BEGIN#NOP#
               IF CED0[0]     EQ BLKW AND 
                  CED [WCEDL] EQ BLKW THEN GOTO COD59; #NO LINE/LABEL#
          END  #NOP#
#*#    END
          #ELSE NOT NOP#
          GOTO SWOIJK[TXPX];  #PUT OP,I,J,K#
      #Q[3]#
COD413: 
          PLIJK3;   #PUT OP,I,J,K[3]# 
          GOTO COD41; 
      #Q[2]#
COD412: 
          PLIJK2;   #PUT OP,I,J,K[2]# 
          GOTO COD41; 
      #Q[1]#
COD411: 
          PLIJK1;   #PUT OP,I,J,K[1]# 
          GOTO COD41; 
      #Q[0]#
COD410: 
          PLIJK0;   #PUT OP,I,J,K[0]# 
COD41:  
           IF IOP GQ S"RXJ" THEN       # PUT IT BACK TO WHAT IT WAS   #  LARRY-R
            BEGIN                                                        LARRY-R
            CFI[CFX] = CFJ[CFX];                                         LARRY-R
            CFJ[CFX] = CFK[CFX];                                         LARRY-R
            END                                                          LARRY-R
          CEDM[0] = CMN[IOP];      #MNEMONIC# 
          GOTO SWCFOP[IOP]; 
          #AJ(+BK)# 
COD421: 
               IJ = EDAO;   GOTO COD420;
          #BJ(+BK)# 
COD422: 
               IJ = EDBO;   GOTO COD420;
          #XJ(+BK)# 
COD423: 
               IJ = EDXO; 
          #RJ(+BK)# 
COD420: 
               IF CFK[CFX] EQ 0 THEN GOTO COD43; #NO K# 
               #RJ+BK#
                    CEDOJK[0] = EDPBO+CFK[CFX]; #+BK# 
COD43:  
                    CEDOJ[0] = IJ+CFJ[CFX]; #RJ#
                    GOTO COD57; 
          #AJ-BJ# 
COD44:  
               CEDOJK[0] = EDMBO+CFK[CFX];      #-BK# 
               IJ = EDAO;   #AJ INDEX#
               GOTO COD43;
          #-BK(+BJ)#
COD46:  
               CEDOK[0] = EDMBO+CFK[CFX]; #-BK# 
               IF CFJ[CFX] EQ 0 THEN GOTO COD57;  #NO BJ# 
               #-BK+BJ# 
                    CEDOKJ[0] = EDPBO+CFJ[CFX]; #+BJ# 
                    GOTO COD57; 
          #JK#
COD48:  
               KW = WCEDO;    KB = 0;   #INIT WORD,BIT INDICES# 
               CVTOD(CFJK[CFX]);             #CONVERT JK# 
               GOTO COD57;
          #-XK(-XJ)#
          #-XK+XJ#
COD502: 
               IJ = EDPXO;    GOTO COD50; 
          #-XK-XJ#
COD501: 
               IJ = EDMXO;    GOTO COD50; 
          #-XK*XJ#
COD500: 
               IJ = EDTXO;
COD50:  
               CEDOKJ[0] = CFJ[CFX]+IJ;           #+XJ# 
          #-XK# 
COD51:  
               CEDOK[0] = CFK[CFX]+EDMXO;         #-XK# 
               GOTO COD57;
          #(BJ,)XK #
COD52:  
          IF CFJ[CFX] NQ 0 THEN GOTO COD54;  #BJ,XK#
          #XK#
COD53:  
          CEDOJ[0] = EDXO+CFK[CFX];       #XK#
          GOTO COD57; 
          #BJ,XK# 
COD54:  
          CEDOJK[0] = EDCXO+CFK[CFX]; #,XK# 
          CEDOJ[0] = EDBO+CFJ[CFX];  #BJ# 
          GOTO COD57; 
          #XJ/XK# 
COD564: 
               CEDOJK[0] = CFK[CFX]+EDDXO;    #/XK# 
               GOTO COD56;
          #XJ*XK# 
COD563: 
               CEDOJK[0] = CFK[CFX]+EDTXO;    #*XK# 
               GOTO COD56;
          #XJ-XK# 
COD562: 
               CEDOJK[0] = CFK[CFX]+EDMXO;    #-XK# 
               GOTO COD56;
          #XJ+XK# 
COD561: 
               CEDOJK[0] = CFK[CFX]+EDPXO;    #+XK# 
          #XJ#
COD56:  
               CEDOJ[0] = EDXO+CFJ[CFX];  #XJ#
COD57:  
          CEDMI[0] = CFI[CFX]+HZERO;  #--I# 
COD58:  
          PTLST(ACED);        #PUT LINE#
          PRBLK;    #CLEAR LINE#
          CED0[0] = BLKW;     #CLEAR LINE NO.#
COD59:  
          TXPX = TXPX+1; #INCR Q INDEX# 
#*******************************************************************# 
COD60:  
          IF TXPX LS 4 THEN GOTO COD64; 
          #E-O-TEXT WORD# 
COD62:  
               CTXQ = 0;           #INIT Q COUNT# 
               TXPX = 0;           #INIT Q INDEX# 
               PTXTPI;   #INCR,CHECK TEXT#
               IF PLIN THEN PTLOC; #LINE# 
          IF IOP EQ ADCNS THEN GOTO ADC30;
     DEF  PCDXI 
               #CFX = CFX+1#; #INCR CF POINTER# 
COD64:  
      PCDXI;             #INCR CF INDEX#
COD65:                                                              #7 #
      IF CFX GQ CFN THEN
      BEGIN#E-O-CF BLOCK# 
 IF NOT CIFB AND NOT CIFL THEN GOTO CF059;
          LTCFL(P<BCF>,CFN,CF059); #LOCATE CF#
          CFX = 0;  #INIT CF INDEX# 
$BEGIN
#*#   CIFW  CDUMP(P<BCF>,CFN,"COD65  CF          ");
$END
      END  #E-O-CF BLOCK# 
      IOP = CFOP[CFX];   #CF OPERATION# 
      GOTO COD00; 
#*******************************************************************# 
      #NOT INSTR# 
     DEF PTLABX 
               #GOTO COD64#;   #NEXT CF ENTRY#
     DEF  PTINTL
               #PROCT(LOCN[IST],GOCTP,LOCTP,3,24)#; #PUT INTL#
     DEF  PTG 
               #CED[3] = "   G      "#;       #PUT "G"# 
#*******************************************************************# 
     #LABL# 
COD70:  
               IF NOT PLIN THEN PTLABX;  #NOT LINE# 
               #BEGIN LINE# 
                 IF CED[WCEDL] NQ BLKW THEN 
                 BEGIN#PREVIOUS LABL# 
                  PTLST(ACED);     #PUT LABL# 
                  CED[WCEDL] = BLKW;   CED[WCEDM] = BLKW; 
                 END  #PREVIOUS LABL# 
                 #ELSE NO PREVIOUS LABEL# 
                  IST = CFST[CFX];  #SYMB TABL# 
                  IF NNAM[IST] THEN 
                  BEGIN#INTL# 
                    PTG;      #PUT "G"# 
                    PTINTL;   #PUT INTL NO.#
                    PTLABX; 
                  END  #INTL# 
                  #ELSE USER LABL#
                    PTLAB(IST);    #PUT LABL# 
                    PTLABX; 
                  #END  USER LABL#
               #END  LINE#
#*******************************************************************# 
     #CNTL# 
COD74:  
     IST = CFST[CFX]; 
               GOTO COD64;
#*******************************************************************# 
      #TRB# 
COD76:  
          IKK = -1;      #OFFSET = -1#
          IST = CFST[CFX];
          IJK = CFML[CFX]*8;  #POSITION LINE NO.# 
          IF POBJ THEN B<30,15>CPT[CTX] = IJK; #LINE NO.(ALWAYS LOWER)# 
          IOP = S"TRJ";   #CHANGE OP# 
          GOTO COD01; 
#*******************************************************************# 
     #XJ# 
COD78:  
          IF POBJ THEN CPT[CTX] = HXJO;    #XJ OCTAL# 
          IF NOT PLIN THEN GOTO COD62;  #NO LINE# 
          #ELSE LINE# 
               TXPX = 4;
               CEDOC[0] = HXJOC0;  #XJ OCTAL DISPLAY# 
               CEDOC[1] = HXJOC1; 
               CEDM[0] = HXJ;      #XJ# 
               GOTO COD28;
          #END  LINE# 
#*******************************************************************# 
#*******************************************************************# 
     #PRSC# 
COD80:  
          TXPX = 3;      #UPPER#
          GOTO COD83; 
     #PRSD# 
COD82:  
          TXPX = 5;      #LOWER#
COD83:  
          IST = CFST[CFX];    #SYMB TBL POINTER#
          IKK = CFKK[CFX];    #KK#
COD84:  
          IJK = 0;
          IF POBJ THEN
          BEGIN#OBJ#
               CPT[CTX] = 0;  #CLEAR TEXT WORD# 
          END  #OBJ#
           IF NOT PLIN THEN GOTO COD86;      #NO LINE#
          #BEGIN LINE#
               PRZO1;    #ZERO OCTAL FLD# 
               PRZO2; 
               PRO60;    #PUT "60/0"# 
COD85:  
               PRVFD;    #PUT "VFD"#
          #END LINE#
COD86:  
          IF IST NQ 0 THEN GOTO COD01;  #RELOC# 
     #NULL# 
          IF NOT PLIN THEN GOTO COD62;  #NO LINE# 
          #BEGIN LINE#
               GOTO COD28;
          #END LINE#
#*******************************************************************# 
     #PRST# 
COD87:  
          CFX = CFX+1;   #INCR CF INDEX#
          IF POBJ THEN CPT[CTX] = CF[CFX];   #OBJ#
          IF NOT PLIN THEN GOTO COD62;   #NO LINE#
          #ELSE LINE# 
               PROCT(CF[CFX],0,57,1,0);   #OCTAL# 
               PRVFD;    #"VFD"#
   IF CF[CFX] EQ 0 THEN BEGIN 
                        PRO60;#PUT "60/0"#
                        TXPX = 3 ;
                        GOTO COD28; 
                        END 
               CEDO[0] = "60/10L    ";
               B<36,24>CEDO[0] = B<0,24>CF[CFX];
               B<0,36>CEDO[1] = B<24,36>CF[CFX];
               TXPX = 3;
               GOTO COD28;
          #END  LINE# 
#*******************************************************************# 
      #TRC# 
COD88:  
          IKK = 0; IKKT = 0;  #CLEAR OFFSETS# 
          IST = CFST[CFX];    #PROG/PROC INDEX# 
          FIND(IST,NP);       #NAME#
          C<0,CNAM>IKKT = NAME[NP]; 
          IST = MERV[IST];                 #RETURN INFO IS IN MERV     #
          IF CLAS[IST] EQ S"PROG" THEN IST = 0; 
          TXPX = 6;      #FULL WORD#
COD89:  
          IF POBJ THEN
          BEGIN#OBJ#
               CPT[CTX] = IKKT; 
               IF NOT PLIN THEN GOTO COD86;  #NO LINE#
          END  #OBJ#
          #ELSE LINE# 
               PRZO2;    #PUT "0"S# 
               PROCT(IKKT,0,39,1,0);    #PUT OCTAL# 
               CEDO[0] = "42/7L     ";
               B<30,30>CEDO[0] = B<0,30>IKKT;     #PUT 7H#
               IF CEDO[0] LAN O"7777" EQ 0 THEN CEDO[0] = CEDO[0]+HBLK; 
               CEDO[1] = "  ,18/0   ";
               B<0,12>CEDO[1] = B<30,12>IKKT; 
               GOTO COD85;
          #END  LINE# 
#*******************************************************************# 
     #RMRK# 
COD90:  
      IC = CFML[CFX];    #MSG LNG#
      IF NOT PLIN THEN GOTO COD92;  #NO LINE# 
      #ELSE LINE# 
               FOR I = 7 STEP 1 UNTIL 11 DO 
               BEGIN#I# 
                    IF IC LQ  0 THEN GOTO COD64;  #E-O-REMARK#
                    IC = IC-1;     #DECR MSG LNG# 
                    CED[I] = CFD[CFX];  #REMARK#
                    CFX = CFX+1;   #INCR CF INDEX#
               END  #I# 
      #END  LINE# 
      #BEGIN NO LINE# 
COD92:  
          CFX = CFX+IC;  #INCR CF INDEX#
          GOTO COD64; 
      #END   NO LINE# 
     #CMNT# 
COD94:  
      IC = CFML[CFX];    #MSG LNG#
      IF NOT PLIN THEN GOTO COD92;  #NO LINE# 
      #ELSE LINE# 
               FOR I = 0 STEP 1 UNTIL 7 DO
               BEGIN#I# 
                    IF IC LQ  0 THEN GOTO COD95;  #E-O-COMMENT# 
                    IC = IC-1;     #DECR MSG LNG# 
                    CERC[I] = CFD[CFX]; #COMMENT# 
                    CFX = CFX+1;   #INCR CF INDEX#
               END  #I# 
               I = 7; 
COD95:  
               PTLST(ACER);   #PUT COMMENT# 
               FOR J = I STEP -1 UNTIL 0 DO CERC[J] = BLKW; 
               GOTO COD92;
      #END  LINE# 
#*******************************************************************# 
      #LINE#
COD96:  
  XREF ITEM  STRTLNE;                                                    NEWFEAT
  XREF ITEM ENDLNE;                                                      NEWFEAT
          IJ = CFML[CFX];                                                NEWFEAT
     IF IJ LS STRTLNE OR IJ GR ENDLNE THEN BEGIN #NO O NOW#              NEWFEAT
                                              PLIN = FALSE;              NEWFEAT
                                                 END                     NEWFEAT
                                              ELSE  PLIN = TRUE;         NEWFEAT
          IF NOT CIFL THEN                                               JUNK 
            PLIN = FALSE;                                                JUNK 
          IF PLIN THEN                                                   JUNK 
            BEGIN                                                        JUNK 
               CED0[0] = "   00000. ";
               IJ = CFML[CFX];     #LINE NO.# 
               IF IJ LS 10 THEN 
               BEGIN#1 DIGIT# 
                    B<42,6>CED0[0] = IJ+HZERO;
               END  #1 DIGIT# 
                                                                         JUNK 
               ELSE   #  > 1 DIGIT  #                                    JUNK 
                  BEGIN                                                  JUNK 
                    KB = 42;  #BIT INDEX# 
COD97:  
                    IK = IJ/10; 
                    B<KB,6>CED0[0] = (IJ-IK*10)+HZERO;
                   IF  IK  NQ  0  THEN                                   JUNK 
                      BEGIN                                              JUNK 
                         IJ = IK; 
                         KB = KB-6; 
                         GOTO COD97;
                      END  # IK NQ 0 #                                   JUNK 
                  END   # MORE THAN  1 DIGIT #                           JUNK 
            END  # OUTPUT OF LINE NUMBER   #                             JUNK 
                                                                         JUNK 
          IF CIDDB NQ 0 THEN                                             JUNK 
              # CID OPTION ON   #                                        JUNK 
            BEGIN                                                        JUNK 
#                                                                        JUNK 
            OUTPUT LINE NUMBER TABLE                                     JUNK 
            TRANSFORM  THIS  TO   SB0  B2+LINE                           JUNK 
            PROCESS THE SB0... IN THE NORMAL FASHION                     JUNK 
#                                                                        JUNK 
            IOP = QCFOP"BBPK";       #FOR COD000 #                       JUNK 
            IJ = CFML[CFX];          # SAVE LINE NUMBER #                JUNK 
            IK = CTXL ;              # SAVE CODE ADDRESS #               JUNK 
                                                                         JUNK 
            CFOP[CFX]= QCFOP"BBPK" ; # 61-INSTRUCTION  SBI BJ + K  #     JUNK 
            CFI[CFX] = 0 ;           # I-REG = 0 #                       JUNK 
            CFJ[CFX] = 2 ;           # B2 #                              JUNK 
            CFKK[CFX]= IJ;           # LINE NUMBER #                     JUNK 
            CFST[CFX]= 0;                                                JUNK 
            PTLINETAB (IJ,IK);  #PUT LINE INTO 57-TABLE  #               JUNK 
            GOTO  COD00;       # GO PROCESS  SB0    #                    JUNK 
            END   # DEBUG OPTION  #                                      JUNK 
                                                                         JUNK 
          GOTO  COD64;         # GO PROCESS NEXT INSTRUCTION  #          JUNK 
#*******************************************************************# 
CF058:  
CF059:  
     #E-O-PROG# 
CF060:  
        IF POBJ  THEN 
        BEGIN #OBJ# 
         PTXTPP;    #PUT TEXT#
         IF CPFX GR 1 OR CPFB THEN PTFIL;   #PUT FILL # 
         IF CPLX GR 1 OR CPLB THEN PTLNK;   #PUT LINK # 
         IF CILNX NQ 0 THEN   # OUTPUT LAST 57-TABLE  #                  JUNK 
           BEGIN                                                         JUNK 
           CILNWC[0] = CILNX;                                            JUNK 
           PTOBJ ( ACILN , CILNX+1 );                                    JUNK 
           END                                                           JUNK 
                                                                         JUNK 
         IF CIDDB NQ 0 THEN                                              JUNK 
             # CID OPTION ON  #                                          JUNK 
           BEGIN                                                         JUNK 
#                                                                        JUNK 
              OUTPUT  SYMBOL TABLE FOR LOADER  (56-TABLE )               JUNK 
#                                                                        JUNK 
      ITEM CRSLC   ,         #CURRENT  SLC #                             JUNK 
           SYMI   ,          # SYMBOL TABL INDEX #                       JUNK 
           NAMI   ;          # NAME ENTRY      #                         JUNK 
      ITEM  BNDI;     # BOUND INDEX #                                    JUNK 
      ITEM  NBND;                                                        JUNK 
      ITEM  BPAR;                                                        JUNK 
                                                                         JUNK 
#                                                                        JUNK 
            SEARCH SLC"S TO OUTPUT SYMBOLS INTO 56-TABLES                JUNK 
#                                                                        JUNK 
           CRSLC = SPLC ;     # START OF SLC CHAIN  #                    JUNK 
                                                                         JUNK 
                                                                         JUNK 
           FOR I=I  WHILE CRSLC NQ 0 DO                                  JUNK 
             BEGIN       # PROCESS  THIS SLC   #                         JUNK 
                                                                         JUNK 
             SWITCH   SWSLC:  QESDC                                      JUNK 
                    SLNOGO:   NULL  ,                                    JUNK 
                    SLNOGO:   LITL ,                                     JUNK 
                    SLNOGO:   FILE ,                                     JUNK 
                    SLNOGO:   ADCN ,                                     JUNK 
                    SLNOGO:   CMPL ,                                     JUNK 
                    SLNOGO:   XTRN ,                                     JUNK 
                    SLCODE:   CODE ,                                     JUNK 
                    SLDATA:   DATA ,                                     JUNK 
                    SLDATA:   COMM ;                                     JUNK 
                                                                         JUNK 
             GOTO  SWSLC[ESDC[CRSLC]] ;                                  JUNK 
                                                                         JUNK 
                                                                         JUNK 
SLCODE:                                                                  JUNK 
#                                                                        JUNK 
               PROCESS LABELS, PROCS, FUNCS                              JUNK 
#                                                                        JUNK 
                                                                         JUNK 
             SYMI = BABY[CRSLC];     # FIRST ENTRY IN CODE CHAIN  #      JUNK 
                                                                         JUNK 
             FOR I=I  WHILE SYMI NQ 0  DO                                JUNK 
               BEGIN                                                     JUNK 
                  #  BUILD ENTRY  #                                      JUNK 
                                                                         JUNK 
             IF   NOT NNAM[SYMI]   THEN                                  JUNK 
               BEGIN                                                     JUNK 
               IF CISYX + CODENT  GQ ECISY THEN  # TABLE FULL #          JUNK 
                 BEGIN                                                   JUNK 
                 PTSYTAB ;                                               JUNK 
                 END                                                     JUNK 
                                                                         JUNK 
               FIND (SYMI , NAMI) ;    # GET NAME ENTRY #                JUNK 
               CISYNM[CISYX] = NAMEZERO ( NAMI ); #ZERO FILL NAME #      JUNK 
               CISYAD[CISYX] = LOCN[SYMI];                               JUNK 
               CISYRB[CISYX] = 1;    # RELOCATION NUMBER OF CODE  #      JUNK 
               CISYTY[CISYX] = S"BOOL";   # TYPE = FORTRAN BOOLEAN#      JUNK 
               CISYNE[CISYX] = CODENT;    # NUMBER OF WORDS THIS ENTRY#  JUNK 
               CISYX = CISYX + CODENT;    # BUMP SYTAB INDEX  #          JUNK 
                                                                         JUNK 
                                                                         JUNK 
               END   # NAMED ENTRY        #                              JUNK 
                                                                         JUNK 
               SYMI  = ASEQ[SYMI] ;                                      JUNK 
                                                                         JUNK 
               END   # CODE CHAIN #                                      JUNK 
                                                                         JUNK 
             GOTO  SLNOGO;                                               JUNK 
                                                                         JUNK 
                                                                         JUNK 
SLDATA:        # PROCESS LOCALS,ENTRY-DATA,COMMON-BLOCKS  #              JUNK 
                                                                         JUNK 
             SYMI = BABY[CRSLC];                                         JUNK 
                                                                         JUNK 
             FOR I=I  WHILE SYMI NQ 0 DO                                 JUNK 
               BEGIN                                                     JUNK 
                 IF CLAS[SYMI] EQ S"DATA"    # SCALAR  #                 JUNK 
               AND NOT NNAM[SYMI] THEN                                   JUNK 
#                                                                        JUNK 
               PROCESS NAMED SCALARS                                     JUNK 
#                                                                        JUNK 
                   BEGIN                                                 JUNK 
                   IF CISYX + DATENT GQ ECISY THEN  # TABLE FULL #       JUNK 
                     BEGIN                                               JUNK 
                     PTSYTAB;                                            JUNK 
                     END                                                 JUNK 
                                                                         JUNK 
                   FIND (SYMI, NAMI) ;                                   JUNK 
                  CISYNM[CISYX] =NAMEZERO ( NAMI ); # ZERO FILL NAME  #  JUNK 
                  CISYRB[CISYX] =  RLNO[SYMI];                           JUNK 
                  CISYAD[CISYX] =  LOCN[SYMI];                           JUNK 
                  CISYNE[CISYX] =  DATENT;                               JUNK 
                   IF LEVL[SYMI] NQ S"LEV1"  THEN                        JUNK 
                     BEGIN                                               JUNK 
                     CISYLC[CISYX] = TRUE ;    #LCM #                    JUNK 
                     END                                                 JUNK 
                                                                         JUNK 
                      # GET CID TYPE FROM SYMPL TYPE  #                  JUNK 
                   CISYTY[CISYX] = XFRMTYP(TYPE[SYMI]);                  JUNK 
                   IF CISYTY[CISYX] EQ S"CHAR"   THEN                    JUNK 
                   BEGIN                                                 JUNK 
                      # SET NUMBER OF CHARACTERS  #                      JUNK 
                     CISYCL[CISYX] = NBYT[SYMI];                         JUNK 
                   END                                                   JUNK 
                                                                         JUNK 
                   CISYX = CISYX + DATENT;                               JUNK 
                                                                         JUNK 
                 END   # NAMED DATA ENTRY  #                             JUNK 
                                                                         JUNK 
                                                                         JUNK 
                IF CLAS[SYMI] EQ  S"TABL" THEN                           JUNK 
#                                                                        JUNK 
               PROCESS ARRAYS                                            JUNK 
#                                                                        JUNK 
                  BEGIN                                                  JUNK 
                  IF  CISYX+DATENT+NDIM[SYMI]*2 GQ  ECISY  THEN          JUNK 
                    BEGIN                                                JUNK 
                    PTSYTAB;                                             JUNK 
                    END                                                  JUNK 
                                                                         JUNK 
                IJ = SYMI ;                                              JUNK 
                                                                         JUNK 
                IF  NNAM[SYMI] THEN   # GET FIRST ITEM NAME WHEN NO      JUNK 
                                         ARRAY NAME  #                   JUNK 
                  BEGIN                                                  JUNK 
                  IJ =0;                                                 JUNK 
                  IK = BABY[SYMI];                                       JUNK 
                                                                         JUNK 
                  FOR I=I  WHILE  IK NQ 0 DO                             JUNK 
                    BEGIN                                                JUNK 
                    IF NOT NNAM[IK]   THEN                               JUNK 
                      BEGIN                                              JUNK 
                      IJ = IK;   # FIND LAST NAMED ITEM IN BABY CHAIN    JUNK 
                                   ITS WAS DECLARED FIRST  #             JUNK 
                      END                                                JUNK 
                    IK = ASEQ[IK];                                       JUNK 
                    END                                                  JUNK 
                                                                         JUNK 
                  END                                                    JUNK 
                                                                         JUNK 
                                                                         JUNK 
                IF  IJ NQ 0  THEN   # HAVE A NAME TO CALL THIS ARRAY #   JUNK 
                  BEGIN                                                  JUNK 
                                                                         JUNK 
                  # OUTPUT HEADER WORDS FOR THIS ARRAY   #               JUNK 
                  FIND (IJ , NAMI );                                     JUNK 
                                                                         JUNK 
                  CISYNM[CISYX] =  NAMEZERO ( NAMI ) ; #ZERO FILL NAME # JUNK 
                  CISYRB[CISYX] =  RLNO[SYMI];                           JUNK 
                  CISYAD[CISYX] =  LOCN[SYMI];                           JUNK 
                  CISYTY[CISYX] = S"BOOL";   # BOOLEAN COMES OUTIN       JUNK 
                                                OCTAL  #                 JUNK 
                                                                         JUNK 
                                                                         JUNK 
                   # SET NUMBER OF DIMENSOINS  #                         JUNK 
                  IF WENT[SYMI] NQ 1 THEN                                JUNK 
                    BEGIN                                                JUNK 
                     # EP > 1   #                                        JUNK 
                    CISYDM[CISYX] = NDIM[SYMI] + 1;                      JUNK 
                    END                                                  JUNK 
                  ELSE                                                   JUNK 
                    BEGIN                                                JUNK 
                    CISYDM[CISYX] = NDIM[SYMI];                          JUNK 
                    END                                                  JUNK 
                                                                         JUNK 
                  IF LEVL[SYMI] NQ S"LEV1" THEN                          JUNK 
                    BEGIN                                                JUNK 
                    CISYLC[CISYX] = TRUE ;    # LCM #                    JUNK 
                    END                                                  JUNK 
                                                                         JUNK 
                  CISYNE [CISYX] = 2;     #START COUNTING #              JUNK 
                  BNDI = CISYX;                                          JUNK 
                                                                         JUNK 
                  IF PORS[SYMI]             # SERIAL  #                  JUNK 
                  AND  WENT[SYMI] NQ  1     #  EP > 1 #                  JUNK 
                                    THEN                                 JUNK 
                   BEGIN      # OUTPUT  FIRST SUBSCRIPT AS EP-INDICATOR# JUNK 
                   CISYNE[CISYX] = CISYNE[CISYX] + 2 ;                   JUNK 
                   CISYCB[BNDI] = TRUE ;   # UPPER BOUND  CONSTANT  #    JUNK 
                   CISYCB[BNDI+1]=TRUE ;   # LOWER BOUND  CONSTANT  #    JUNK 
                   CISYLB[BNDI] = TRUE ;   #              PRESENT   #    JUNK 
                   CISYBD[BNDI]   = WENT[SYMI]-1;   # UPPER BOUND   #    JUNK 
                   CISYBD[BNDI+1] = 0;            # LOWER         #      JUNK 
                   BNDI = BNDI + 2 ;                                     JUNK 
                   END                                                   JUNK 
                                                                         JUNK 
#                                                                        JUNK 
                  OUTPUT USER SPECIFIED BOUNDS                           JUNK 
#                                                                        JUNK 
                  NBND = NDIM[SYMI]  ;                                   JUNK 
                  BPAR = SBSC[SYMI];    # BOUND PAIR  #                  JUNK 
                                                                         JUNK 
                  FOR  I=I  WHILE NBND NQ 0 DO   #LOOP ON BOUNDS #       JUNK 
                    BEGIN                                                JUNK 
                                                                         JUNK 
                    IF LBND[BPAR] NQ DDEL[BPAR] - 1 THEN                 JUNK 
                        # LOWER BOUNDS NQ UPPER BOUNDS  #                JUNK 
                    BEGIN                                                JUNK 
                                                                         JUNK 
                    CISYNE[CISYX] = CISYNE[CISYX] + 1;                   JUNK 
                    CISYBD[BNDI]  = DDEL[BPAR] + LBND[BPAR] - 1; #UPPER# JUNK 
                    CISYCB[BNDI]  = TRUE ;                               JUNK 
                    BNDI = BNDI+1;                                       JUNK 
                                                                         JUNK 
                    IF LBND[BPAR] NQ 1 THEN                              JUNK 
                      BEGIN    # NON-DEFAULT LOWER BOUND #               JUNK 
                      CISYNE[CISYX] = CISYNE[CISYX] + 1 ;                JUNK 
                      CISYLB[BNDI-1] = TRUE;   #LOWER BOUND PRESENT #    JUNK 
                      CISYBD[BNDI]   = LBND[BPAR] ;  # LOWER BOUND  #    JUNK 
                      CISYCB[BNDI]   = TRUE;         #       CONSTANT #  JUNK 
                      BNDI = BNDI + 1;                                   JUNK 
                      END                                                JUNK 
                                                                         JUNK 
                    END # NON ZERO BOUNDS  #                             JUNK 
                  ELSE                                                   JUNK 
                    BEGIN                                                JUNK 
                      # DECREMENT BOUNDS COUNT  #                        JUNK 
                    CISYDM[CISYX] = CISYDM[CISYX] -1;                    JUNK 
                    END                                                  JUNK 
                                                                         JUNK 
                    NBND = NBND - 1;                                     JUNK 
                    BPAR = BPLK[BPAR] ;                                  JUNK 
                    END   # BOUNDS PAIRS  #                              JUNK 
                                                                         JUNK 
                                                                         JUNK 
                  IF NOT PORS[SYMI]                #PARALLEL AND EP>1 #  JUNK 
                  AND WENT[SYMI] NQ 1     THEN                           JUNK 
                    BEGIN                                                JUNK 
                    CISYNE[CISYX]  = CISYNE[CISYX] + 2 ;                 JUNK 
                    CISYCB[BNDI] = TRUE ;     # CONSTANT UPPER BOUND #   JUNK 
                    CISYLB[BNDI] = TRUE;     #  LOWER BOUND PRESENT  #   JUNK 
                    CISYCB[BNDI+1]=TRUE;     #           LOWER      #    JUNK 
                    CISYBD[BNDI]  = WENT[SYMI]-1;  #  UPPER BOUND  #     JUNK 
                    CISYBD[BNDI+1]= 0 ;          #  LOWER        #       JUNK 
                    BNDI = BNDI + 2;                                     JUNK 
                    END                                                  JUNK 
                                                                         JUNK 
                  CISYX = BNDI + 2;                                      JUNK 
                  END   # NAMED ARRAY #                                  JUNK 
                                                                         JUNK 
                END   # ANY ARRAY #                                      JUNK 
                                                                         JUNK 
                                                                         JUNK 
               SYMI = ASEQ[SYMI] ;                                       JUNK 
               END  # DATA  CHAINS #                                     JUNK 
                                                                         JUNK 
SLNOGO:                                                                  JUNK 
                                                                         JUNK 
             CRSLC = ASEQ[CRSLC];                                        JUNK 
                                                                         JUNK 
             END                                                         JUNK 
                                                                         JUNK 
         CISYFT[0] = TRUE;   # OUTPUT FINAL TABLE  #                     JUNK 
         PTSYTAB ;                                                       JUNK 
         END   # DEBUG OPTION   #                                        JUNK 
                                                                         JUNK 
                                                                         JUNK 
         IF CPXN[0] NQ 0 THEN PXFER;    #PUT XFER#
$BEGIN
#*#   CDMPW  ACPX),2 ,"CF060  XFER      "); 
$END
        END   #OBJ# 
      IF NOT PLIN THEN GOTO CF070;
         #ELSE LINE#
               CENM[0] = HEND;     #END#
               CENO[0] = IXFRN; 
               PTLST(ACEN);        #PUT END LINE# 
         #END  LINE#
CF070:  
        IF PRGML NQ 0              # IF PROGRAM LENGTH HAS BEEN SET    #
        THEN
          BEGIN 
          IF B<59 - "L">OPTION NQ 0    # AND L"0                       #
            OR SHRTLST NQ 0 
          THEN
            BEGIN 
            BINOCT (LNMSG,20,PRGML,6);
            PTLSTV (LNMSG,4);      # PRINT PROGRAM LENGTH MESSAGE      #
            END 
          END 
  
        IF LMAP OR LXREF THEN 
        BEGIN#COMMON BLOCKS LISTING#
         WHCHED = 14 ;             # SET HEADING TYPE FOR COMMON BLOCKS#
         LINES = 58 ;              # SET LINE COUNT TO ONE LESS MAX NO #
         FOR I = 3 STEP 1 UNTIL COMLIM DO 
           BEGIN#I# 
             IF BLOCPST[I] EQ 0 THEN GOTO ENDCOMBK ;
                 #BEGIN NAME# 
                   B<36,24>COMNAM [CMPX] = B< 0,24>BLOCNAM[I] ; 
                   B< 0,18>COMNAM1[CMPX] = B<24,18>BLOCNAM[I] ; 
                 #END NAME# 
                 #BEGIN LENGTH# 
                   B<54,6>COMLEN[CMPX] = B<0,3>BLOCSIZ[I] + HZERO ; 
                   K = 0 ;
                   FOR J = 3 STEP 3 UNTIL 15 DO 
                     BEGIN#J# 
                       B<K,6>COMLEN1[CMPX] = B<J,3>BLOCSIZ[I] + HZERO ; 
                       K = K + 6 ; # INCREMENT BIT INDEX               #
                     END#J# 
                   B<30,6>COMLEN1[CMPX] = O"02" ;  # B = BINARY        #
                 #END LENGTH# 
                 #BEGIN BLOCK NUMBER# 
                   IF I GQ 10 THEN
                     BEGIN#2 DIGITS#
                       IK = I/10 ;
                       COMNUM [CMPX] = IK + O"0333" ; 
                       COMNUM1[CMPX] = I - IK * 10 + HZERO ;
                     END#2 DIGITS#
                     ELSE#1 DIGIT#
                       COMNUM [CMPX] = I + O"0333" ;
                 #END BLOCK NUMBER# 
                 #BEGIN LIST# 
                   CMPX = CMPX + 4 ;  # INCREMENT INDEX                #
                   IF CMPX GR 8 THEN
                     BEGIN#END OF LINE# 
                       PTLST(COMARY) ;      # PUT LINE/CLEAR BUFFER    #
                       FOR J = 0 STEP 1 UNTIL 12 DO 
                         COMBLNK[J] = BLKW ;
                       CMPX = 0 ;           # INITIALIZE INDEX         #
                     END#END OF LINE# 
                 #END LIST# 
           END#I# 
ENDCOMBK: 
           IF CMPX NQ 0 THEN PTLST(COMARY) ;  # FLUSH COMMON BLOCKS    #
        END#COMMON BLOCKS LISTING#
        RETURN ;
END 
      TERM
