*DECK             CODGK2
USETEXT   TSOURCE 
USETEXT   TTARGET 
USETEXT   TCEXECQ 
USETEXT   TSYMCNS 
USETEXT   TREGNOS 
USETEXT   TCOM39Q 
USETEXT   TCOM78Q 
USETEXT   TCEXEC
USETEXT   TCOM88
USETEXT   TCOM88K 
    PROC CODGK2   ; 
         BEGIN    #      CODGK2                                        #
  
  
  
  
*CALL COMEX 
  
*CALL COM39A
  
  
  
  
  
         XREF     FUNC  GETEMP  ; 
         XREF     PROC  BGB00 ; 
          XREF PROC BINDEC; 
         XREF     PROC  CIE00 ; 
         XREF     PROC  GIU00 ; 
         XREF     PROC  CNO00 ; 
         XREF     PROC  PTCFL  ;
         XREF     PROC  GICFB  ;
         XREF     PROC  ESDH00  ; 
         XREF     PROC  EEOS00  ; 
         XREF     PROC  IINSK  ;
         XDEF     PROC  ORP00 ; 
      XREF PROC PTLSTV; 
  DEF MAXNMPRB  #10#  ; 
  
#    JAM TYPES ARE CATEGORISED AS FOLLOWS ------
  
         1    A WORK REG IS AVAILABLE 
         2    DROP A USED LOAD SHORT CONSTANT ETC 
         3    DROP A USED SCALAR LOAD 
         4    DROP A USED SAVED VALUE 
         5    DROP AN UNUSED CONSTANT 
         6    DROP AN UNUSED SCALAR 
         7    DROP AN UNUSED SAVED VALUE
         8    FREE X6 OR X7 BY STORING INTO A TEMP
# 
         ITEM TYPEJ;
$BEGIN                                                                   LARRY-V
         ARRAY JAMARY[5]S(1); 
           ITEM JAMMSG C (0,0,50)  =[ 
    " JAM LINE XXXXX TYPE XXXX RECOVER X REG XX 
:::::" ]; 
         ARRAY [3]; 
           ITEM UNNAME C(0,0,4) =["LOAD" , "WORK" , "STOR" ,"B   " ]; 
$END                                                                     LARRY-V
      ITEM
         CFINX    I = 0 ,           #   CODE FILE INDEX                #
         NRJ      I ,               #   NEEDED REGISTERS               #
          NRK;
CONTROL EJECT;
                                        #ORP00 IS THE OUT-OF-REGISTER  #
                                        # PROCEDURE. IT FREES THE TYPE #
                                        # OF REGISTER REQUIRED BY THE  #
                                        # HIGHEST PRIORITY INSTRUCTION #
                                        # IN THE READY SET.            #
    PROC ORP00    ; 
         BEGIN    #      ORP00                                         #
         ITEM     TORP1 I  ;
SWITCH   UNSWI
         RFP20 ,  #  LOAD                                              #
         RFP21 ,  #  WORK                                              #
         RFP22 ,  #  STORE                                             #
         RFP23 ;  #  BREG                                              #
RFP10:  
          $BEGIN
         NSOR  =  NSOR + 1 ;
          $END
         NRJ  =   UNSRJ [0]  ;
         NRK  =   UNSRK [0]  ;
         T1   =   UNSTY [0]  ;
          TYPEJ = 8;
         IF UNSTI[0] NQ FOL[XPRS] THEN
              # MOVE TO HEAD OF READY SET  #
           BEGIN
         I = UNSTI[0];
               # FIND BOL OF UNSTI  # 
           T2 = FOL[XPRS];
NEXTLINK: 
           IF FOL[T2] NQ I THEN 
             BEGIN
             T2 = FOL[T2];
             GOTO NEXTLINK; 
             END
           FOL[T2] = FOL[I];   # LINK OUT I  #
           FOL[I] = FOL[XPRS];   # LINK BACK IN AT HEAD OF READY SET  # 
           FOL[XPRS] = I; 
           END
         GOTO  UNSWI [ T1 ] ; 
RFP20:  
         CALL  LRR00 ;
         GOTO  RFPXIT  ;
RFP21:  
         CALL  WRR00 ;
         GOTO  RFPXIT  ;
RFP22:  
         CALL  GSR00  ( TORP1 ) ; 
         GOTO  RFPXIT ; 
RFP23:  
         CALL  BRR00   ;
         GOTO  RFPXIT ; 
RFPXIT: 
         RPFRC =  TRUE ;            #   REGISTER PROBLEM FORCE         #
$BEGIN                                                                   LARRY-V
IF B<7,4>INTOPS NQ 0 THEN                                                LARRY-V
BEGIN  #PRINT JAM MESSAGE#                                               LARRY-V
         BINDEC ( JAMARY , 10 , LINE , 5 );    # STORE LINE NO  # 
         C<21,4> JAMMSG[0] = UNNAME [UNSTY[0]] ;
         C<34,1> JAMMSG[0] =  TYPEJ;
         C<41,1> JAMMSG[0] = REGI - XREG0 + O"33";
         PTLSTV ( JAMARY , 5  );
END  #PRINT JAM MESSAGE#                                                 LARRY-V
$END                                                                     LARRY-V
         XREF PROC JAMM;
          IF TYPEJ NQ 1  THEN 
           BEGIN
  
            IF TYPEJ LS 5 THEN
               # WANT TO DROP A USED LOAD   # 
              BEGIN 
              NUMPROB = NUMPROB + 1 ; 
              IF NUMPROB LS MAXNMPRB  THEN
                GOTO CONRECR  ; 
              END 
  
            IF NOT JAM THEN 
            JAMM;       # ENTER JAM MODE - DO NOT RETURN HERE  #
            END 
CONRECR:  
         THISXRG = REGI;
         RETURN   ; 
CONTROL EJECT;
    PROC LRR00    ; 
                                        #LRR00 FREES A LOAD REGISTER   #
                                        # PROTECTING THE REGISTERS     #
                                        # SPECIFIED BY NRJ AND NRK.    #
         BEGIN    #       LRR00                                        #
#        LOAD REGISTER REQUIRED                                        #
#                                                                      #
LRR10:  
         CALL  GFW00 ( REGI ) ;     #   GET  FREE  WORK REGISTER       #
         IF  REGI  GE  XREG0  THEN GOTO LRR25 ; 
LRR15:  
#        GET  RECOMPUTABLE LOAD REGISTER                               #
         CALL  GRR00 ( REGI , XREG1, XREG5 ) ;
         IF  REGI  GE  XREG1  THEN GOTO LRR30  ;
#                                                                      #
LRR20:  
         CALL  GSR00 ( REGI ) ;     #   OBTAIN A STORE REGISTER        #
#                                                                      #
LRR25:  
#        XMIT  AN UNUSED  LOAD REGISTER  TO REGI                       #
         FOR  I = XREG1 BY 1 UNTIL XREG5  DO
                                                            BEGIN #1# 
         IF FREZA1 AND I EQ XREG1 THEN GOTO LRR255  ; 
          IF FREZA2 AND I EQ XREG2 THEN GOTO LRR255;                     NEWFEAT
               IF I NE NRJ AND I NE NRK THEN
                                                            BEGIN #2# 
                  REGJ = I  ; 
                  GOTO  LRR26 ; 
                                                            END   #2# 
LRR255: 
                                                            END   #1# 
LRR26:  
         CALL  RPXM  ;              #   XMIT                           #
         GOTO  LRRXIT ;             #   REGJ IS NOW FREE               #
#        SAVED LOAD                                                    #
LRR30:  
#        FREE REGI                                                     #
         T1  =  RGMEM [REGI]   ;
         IF T1 GE 0 THEN XREGL [T1] = 0 ; 
         RGMEM [REGI] = -1  ; 
      RGMEM[REGI+XADOFS] = -1;
LRRXIT: 
         END      #      LRR00                                         #
CONTROL EJECT;
    PROC WRR00    ; 
                                        #WRR00 FREES AN X-REGISTER     #
                                        # PROTECTING THE REGISTERS     #
                                        # SPECIFIED BY NRJ AND NRK.    #
         BEGIN    #      WRR00                                         #
WRR10:  
#        GET A RECOMPUTABLE  WORK REGISTER                             #
         CALL  GRR00 ( REGI , XREG0, XREG7 ) ;
         IF  REGI  GE  XREG0 THEN GOTO  WRR30  ;
         CALL  GSR00 (REGI) ;       #   GET A STORE REG                #
         GOTO  WRRXIT ; 
#        FREE  REGI                                                    #
WRR30:  
         T1  =  RGMEM [REGI]   ;
         IF T1 GE 0 THEN XREGL [T1] = 0 ; 
         RGMEM [REGI] = -1 ;
      RGMEM[REGI+XADOFS] = -1;
WRRXIT: 
         END      #      WRR00                                         #
CONTROL EJECT;
    PROC BRR00    ; 
                                        #BRR00 FREES A B-REGISTER      #
                                        # PROTECTING THE REGISTERS     #
                                        # SPECIFIED BY NRJ AND NRK.    #
         BEGIN    #      BRR00                                         #
#                                                                      #
BRR05:  
         FOR  I = BRJ + 1 BY 1 UNTIL BREG7  DO
                                                            BEGIN #1# 
                  REGI = I ;
         T1  =  RGMEM [I] ; 
         IF  T1 LT 0 THEN  GOTO  BRR30 ;
         IF  XREGL [T1] GE XREG0  THEN
                    GOTO  BRR30  ;
                                                            END   #1# 
#                                                                      #
BRR10:  
         FOR  I = BRJ + 1 BY 1 UNTIL BREG7  DO
                                                            BEGIN #1# 
         REGI = I ; 
                  IF  TSYM [RGMEM  [I]] GT 0  THEN
                    GOTO  BRR30 ; 
                                                            END   #1# 
BRR15:  
         CALL  GFW00 ( REGI ) ; 
         IF  REGI  GE XREG0  THEN GOTO  BRR20 ; 
#        GET A RECOMPUTABLE WORK REGISTER                              #
         CALL  GRR00 ( REGI , XREG0 , XREG7 ) ; 
         IF  REGI  GE XREG0  THEN GOTO  BRR20 ; 
         CALL  GSR00 ( REGI ) ; 
#        REGI  IS AN AVAILABLE  XREG TO STORE A B REG                  #
#        FREE  BREG 7                                                  #
BRR20:  
         T1 = RGMEM [REGI] ;
         IF T1 GE 0 THEN XREGL [T1] = 0 ; 
         REGJ  =  BREG7  ;
         REGK  =  BREG0  ;
         INSOPA = ICFTJ  ;
         CALL  IINSK ( QICFOP"TMWR" , 0, 0 ) ;
          $BEGIN
         NREDY =  NREDY + 1 ; 
          $END
BRR21:  
         INSIZ =  1 ; 
         MOP  [INSOPA] = SXI76 ;    #   SXI  BJ + B0                   #
         INX  =   INSOPA  ; 
         REFCT [INSOPA] = 0 ; 
         LSTYP =  QLT"NIL" ;
         CALL  GIU00  ; 
         CALL  CIE00  ; 
         CALL  CNO00  ; 
         CALL  BGB00   ;            #   BASIC GENERATION B             #
#        NOW FREE BREGJ                                                #
BRR22:  
         T1 = RGMEM [REGJ]   ;
         RGMEM [REGI] = T1  ; 
         LIP [T1] = FALSE  ;
         BREGL [T1] = 0  ;
         XREGL [T1] = REGI  ; 
         RGMEM [REGJ] =  -1   ; 
         RGVAL[REGI + XADOFS] = -1;  #FORGET ADDRESS MEMORY#
#                                                                      #
         GOTO BRRXIT ;
#        REGI  IS A B REGISTER WHICH CAN BE FREED HERE                 #
BRR30:  
         T1 = RGMEM [REGI] ;
         IF T1 GT 0 THEN  BREGL [T1] = 0 ;
         RGMEM [REGI] =  - 1   ;
BRRXIT: 
         END      #      BRR00                                         #
CONTROL EJECT;
    PROC GSR00    ( FSR )  ;
                                        #GSR00 FREES A STORAGE REGISTER#
                                        # X6 OR X7.                    #
         BEGIN    #      GSR00                                         #
         ITEM     FSR  I   ;
#                                                                      #
GSR05:  
#        GET RECOMPUTABLE STORE REGISTER                               #
         CALL  GRR00 ( REGI , XREG6, XREG7 ) ;
         IF  REGI GE  XREG6  THEN  GOTO GSR60 ; 
GSR15:  
         CALL  GFW00 ( REGI ) ; 
         IF REGI  LT 0 THEN  GOTO GSR30 ;    #  NO FREE WORK           #
GSR20:  
         IF XREG6 NE NRJ AND XREG6 NE NRK THEN REGJ = XREG6  ;
           ELSE   REGJ = XREG7  ; 
         CALL  RPXM   ;             #   REGJ TO REGI                   #
         FSR  =  REGJ   ; 
         GOTO  GSRXIT  ;
#                                                                      #
#        NO FREE WORK REGISTER                                         #
GSR30:  
          IF XREG6 NQ NRJ 
              AND XREG6 NQ NRK
              AND OPCD[RGVAL[XREG6]] NQ QICFOP"BPSB"
          THEN
              REGI = XREG6; 
          ELSE
              REGI = XREG7; 
         REGJ  =  BREG0  ;
         REGK  =  SUDOR  ;
         KACON =  0  ;
         INSIZ =  2  ;
         INSOPA = ICFTJ ; 
          $BEGIN
         NREDY =  NREDY + 1 ;       #   JUST FOR  BBG00                #
          $END
#        GET TEMPORARY                                                 #
         T1  =    BI - (ICFTI - 1) ;
         T2  =    GETEMP ( T1 ) ; 
         TSYM  [RGMEM [REGI]] =  T2  ;
         AT[ RGMEM[REGI] ]  =  QAT"SCM"  ;    # TEMPS ARE DIRECT SCM   # LARRY-R
         TLUS [T2] =  TRUE ;
#                                                                      #
GSR32:  
          ABSOP [0] = 0 ; 
          ABASP [0] = T2 ;
          ARMEM [ REGI LAN O"7" ] = ABSOP [0] ; 
         CALL  IINSK ( QICFOP"REPL" , T2, 0 )  ;
         MOP  [INSOPA] =  SAI51 ; 
         INX  =  INSOPA  ;
         REFCT [INSOPA] = 0  ;
         LSTYP =  QLT"STOR"  ;
         CALL  GIU00   ;
         CALL  CIE00  ; 
         CALL  CNO00  ; 
         CALL  BGB00   ;
#                                                                      #
GSR33:  
         GOTO  GSR60 ;              #   FREE REGI                      #
#        FREE  REGI                                                    #
GSR60:  
         T1  =  RGMEM [REGI]   ;
         IF T1 GE 0 THEN
                                                            BEGIN #1# 
                  XREGL [T1] = 0  ; 
                  LIP [T1] = FALSE  ; 
                                                            END   #1# 
         RGMEM [REGI] =  - 1  ; 
         RGVAL[REGI + XADOFS] = -1;  #FORGET ADDRESS MEMORY#
         FSR  =  REGI  ;
GSRXIT: 
         END      #      GSR00                                         #
CONTROL EJECT;
    PROC GRR00    ( XR, XA, XB ) ;
                                        #GRR00 SELECTS A RECOMPUTABLE  #
                                        # X-REGISTER IF ONE EXISTS.    #
         BEGIN    #      GRR00                                         #
         ITEM     XR  ; 
         ITEM     XA  ; 
         ITEM     XB  ; 
         ITEM     TX1 ; 
         ITEM     TX2 ; 
         ITEM     TXOP  ; 
         ITEM     XRA I ;           #   2ND  CHOICE                    #
         ITEM     XRB I ;           #   3RD  CHOICE                    #
         ITEM     XRC I ;           #   4TH  CHOICE                    #
         ITEM     XRD I ; 
         ITEM     XRE I ; 
         XR  =  -1 ;
GRR01:  
         XRA  =  0  ; 
         XRB  =  0  ; 
         XRC  =  0  ; 
         XRD  =  0  ; 
         XRE  =  0  ; 
GRR05:  
         FOR I = XA BY 1 UNTIL XB DO
                                                       BEGIN # GRRLOOP #
#        DONT GET X1 IF A1 FROZEN                                      #
         IF FREZA1  AND I EQ XREG1  THEN GOTO  GRR19 ;
          IF FREZA2 AND I EQ XREG2 THEN GOTO GRR19;                      NEWFEAT
         IF I EQ LASTXRG THEN GOTO GRR19; 
         IF   I  NE NRJ  AND I NE NRK  THEN 
                                                            BEGIN #0# 
         TX1  =   RGMEM [I] ; 
GRR07:  
         IF  TX1 LT  0  THEN  GOTO  GRR29  ;
         TXOP  =  OPCD [TX1] ;
GRR08:  
         IF TXOP EQ QICFOP"LDSC" OR 
             TXOP EQ QICFOP"MASK"   THEN
                                                            BEGIN #1# 
          TYPEJ = 2;
                  IF LUSE [TX1] THEN GOTO GRR29 ; 
                  XRC =  I  ; 
                  GOTO GRR19 ;      #   COMPUTABLE BUT UNUSED          #
                                                            END   #1# 
          IF TXOP EQ QICFOP"MSKL" 
          OR TXOP EQ QICFOP"MSKC" THEN
            BEGIN 
               XRC = I ;  #THESE TAKE A BIT LONGER TO GENERATE ---
                                  RATHER NOT LOSE IT# 
               GOTO GRR19;
            END 
#        VALUE NOT  SELF COMPUTABLE                                    #
GRR10:  
         IF  TSYM [TX1] GT 0 THEN   #   VALUE IN MEMORY                #
             IF NOT RLISS[CNO[TX1 ]] THEN                                SMP0088
                                                            BEGIN #1# 
                  IF  LUSE [TX1] THEN 
                                                            BEGIN #2# 
                    XRA =  I  ;     #   IN MEMORY AND USED             #
                    GOTO GRR19 ;    #   CONTINUE SEARCH                #
                                                            END   #2# 
                    XRD =  I  ;     #   IN MEMORY BUT UNUSED           #
                    GOTO GRR19 ;    #   CONTINUE SEARCH                #
                                                            END   #1# 
#        VALUE NOT IN MEMORY YET EITHER                                #
GRR12:  
         IF TXOP EQ QICFOP"SAVE" OR 
            TXOP EQ QICFOP"TSSV" OR 
            TXOP EQ QICFOP"PISR"    THEN
                                                            BEGIN #1# 
                  IF LUSE [TX1]  THEN 
                                                            BEGIN #2# 
                    XRB =  I  ;     #   SAVE AND USED                  #
                    GOTO GRR19 ;    #   CONTINUE SEARCH                #
                                                            END   #2# 
                    XRE  =  I  ;    #   SAVE BUT NOT USED              #
                    GOTO GRR19 ;
                                                            END   #1# 
                                                            END   #0# 
GRR19:  
                                                       END  # GRRLOOP  #
GRR20:  
         IF  XRA  GT 0  THEN        #   TSYM AND USED                  #
                                                            BEGIN #1# 
          TYPEJ = 3;
                  I = XRA  ;
                  GOTO  GRR29 ; 
                                                            END   #1# 
GRR21:  
         IF  XRB  GT 0 THEN 
                                                            BEGIN #1# 
          TYPEJ = 4;
                  I = XRB ; 
                  GOTO GRR27 ;      #   GET  TEMP                      #
                                                            END   #1# 
GRR22:  
         IF  XRC  GT 0 THEN         #                                  #
                                                            BEGIN #1# 
          TYPEJ = 5;
                  I = XRC ; 
                  GOTO GRR29 ;
                                                            END   #1# 
GRR23:  
         IF  XRD  GT 0 THEN 
                                                            BEGIN #1# 
          TYPEJ = 6;
                  I = XRD  ;
                  GOTO GRR29 ;
                                                            END   #1# 
GRR25:  
         IF  XRE  GT 0 THEN 
                                                            BEGIN #1# 
          TYPEJ = 7;
                  I = XRE ;         #   SAVE BUT UNUSED                #
                  GOTO GRR27 ;      #   GET TEMP                       #
                                                            END   #1# 
         GOTO GRRXIT ;
#        GET A TEMP FOR I                                              #
GRR27:  
         XR  =  I  ;
         TX1  =  RGMEM [I] ;
         TX2  =  GETEMP ( BI - TX1 ) ;
         TSYM [TX1] = TX2  ;
         OPN1 [TX1] = TX2  ;
         AINVS [TX1] = TRUE  ;
         TLUS  [TX2] = TRUE  ;
         GOTO  GRRXIT ; 
GRR29:  
         XR = I ; 
GRRXIT: 
         END      #      GRR00                                         #
CONTROL EJECT;
    PROC GFW00    ( FWR ) ; 
                                        #GFW00 SCANS THE X-REGISTER    #
                                        # FOR A DEAD X-REGISTER.       #
         BEGIN    #      GFW00                                         #
         ITEM     FWR  I ;
         FWR =  -1 ;
#                                                                      #
GFW10:  
         FOR  I =  XREG0  BY  1  UNTIL  XREG7  DO 
                                                            BEGIN #1# 
         IF  RGMEM  [I]  LT 0  AND
                  I NE NRJ AND
                  I NE  NRK   THEN
                                                            BEGIN #2# 
                  FWR = I ;         #   FREE REGISTER                  #
          TYPEJ = 1;
                  GOTO  GFWXIT  ; 
                                                            END   #2# 
                                                            END   #1# 
GFWXIT: 
         END      #      GFW00                                         #
CONTROL EJECT;
    PROC RPXM     ; 
                                        #RPXM GENERATES AN INSTRUCTION #
                                        # TO TRANSMIT ONE X-REGISTER   #
                                        # TO ANOTHER X-REGISTER AND    #
                                        # FREES THE ONE TRANSMITTED.   #
         BEGIN    #      RPXM                                          #
         FUNU  =  LOGU  ; 
         REGK  =  REGJ  ; 
         INSOPA = ICFTJ ; 
         INSIZ  = 1 ; 
          $BEGIN
         NREDY =  NREDY + 1 ; 
          $END
RPXM3:  
         CALL  IINSK ( QICFOP"TMWR" , 0 , 0 ) ; 
         MOP   [INSOPA]  =  BXI10 ; 
         INX  =  INSOPA  ;
         REFCT [INSOPA] = 0 ; 
         LSTYP =  QLT"NIL" ;
         CALL  CIE00 ;
         CALL  CNO00 ;
         CALL  BGB00  ;             #   BASIC GENERATION B             #
#        NOW  FREE  REGJ                                               #
#        RECORD THE PREVIOUS CONTENTS OF REGJ AS  BEING IN REGI        #
RPXMS:  
         RGMEM [REGI]  =  RGMEM [REGJ]  ; 
         # RETAIN X-REG ADDRESS MEMORY FOR REGI # 
         RGVAL[REGI + XADOFS] = RGVAL[REGJ + XADOFS] ;
         XREGL [ RGMEM [REGJ ] ] = 0  ; 
         RGMEM [ REGJ ] = -1  ; 
         XREGL [ RGMEM [REGI] ] = REGI  ; 
      RGMEM[REGJ+XADOFS] = -1;
         END      #      RPXM                                          #
#                                                                      #
         END      #      ORP00                                         #
CONTROL EJECT;
         XDEF     PROC   CFW00  ; 
                                        #CFW00 WRITES THE CODE FILE.   #
    PROC CFW00    ( CPTR )  ; 
         BEGIN    #      CFW00                                         #
#**********************************************************************#
SWITCH   CFSW:QCFOPTY                                                    LARRY-R
         KA00:   A     ,                                                 LARRY-R
         KB00:   B     ,                                                 LARRY-R
         KC00:   C     ,                                                 LARRY-R
         KD00:   D     ,                                                 LARRY-R
         KE00:   E     ,                                                 LARRY-R
         KF00:   F     ,                                                 LARRY-R
         KK00:   K     ,                                                 LARRY-R
         KL00:   L     ,                                                 LARRY-R
         KN00:   N     ,                                                 LARRY-R
         KP00:   P     ,                                                 LARRY-R
         KS00:   S     ,                                                 LARRY-R
         KT00:   T   ,                                                   LARRY-R
         KAT00:  AT    ,                                                 LARRY-R
         KTRJ:   TRJ   ,                                                 LARRY-R
         KTIJP:  TIJP  ;                                                 LARRY-R
#**********************************************************************#
         ITEM     CPTR  I  ;
CFW10:  
#                                                                      #
         INX  =   CPTR  ; 
CFW15:  
         IF  INX  LT 0   OR   OPCD [INX]  EQ  QICFOP"EOS"  THEN 
                  GOTO   CFWXIT ; 
          $BEGIN
         IF SKRMK THEN GOTO CFW16  ;  ELSE  GOTO CFW18  ; 
CFW16:  
         IF  NOT  KERRY  THEN  GOTO CFW18   ; 
         IF  MOP [INX]  EQ  QCFOP"LINE" THEN  GOTO CFW18 ;
#        REMARKS  CARD                                                 #
         IF  CFINX  GT  ECF -  6 THEN  CALL  KZ00  ;
         CALL ESDH00  ; 
         CF  [CFINX]  =  RMCFC [0] ;
         CF  [CFINX + 1 ]  = SDC [0] ;
         CF  [CFINX + 2 ]  = SDC [1] ;
         CF  [CFINX + 3 ]  = SDC [2] ;
         CF  [CFINX + 4 ]  = SDC [3] ;
         CFINX =  CFINX + 5  ;
CFW18:  
          $END
#        SWITCH                                                        #
         TX  =  MOP [INX]   ; 
          GOTO  CFSW[CFOPTY[TX]];    # SWITCH ON MOP  #                  LARRY-R
#                                                                      #
#                                                                      #
CFW20:  
         INX  =   FOL [INX]  ;      #   NEXT ICFT ENTRY                #
         GOTO  CFW15  ; 
#                                                                      #
#        RETURN FROM  WRITING CODE FILE  ENTRY                         #
KRT00:  
         GOTO  CFW20  ; 
#                                                                      #
#**********************************************************************#
#                                                                      #
#                                                                      #
#                                                                      #
#                                                                      #
#**********************************************************************#
#**********************************************************************#
#        15 BIT   OP I,J,K  INSTRUCTION                                #
KAT00:                              #    TERMX                         #
         CALL  KY00 ;               #   FORCE FULL WORD                #
KA00: 
#        TEST FOR FULL BUFFER                                          #
         IF  CFINX  GT   ECF  THEN  CALL  KZ00  ; 
#                                                                      #
KA10: 
       CF  [CFINX]  =  0  ; 
         CFOP [CFINX] =  MOP  [INX] ; 
         CFI  [CFINX] =  IDES [INX] ; 
         CFJ  [CFINX] =  JDES [INX] ; 
         CFK  [CFINX] =  KDES [INX] ; 
KA15: 
         CFINX =  CFINX + 1 ;       # NEXT INDEX AND SIZE              #
#                                                                      #
         CLC [0]  =  CLC [0] + 1 ;
         GOTO  KRT00 ;
#**********************************************************************#
#        TRACE IJP  CALL TO  FORMAL PARAMETER PROC                     #
KTIJP:  
#        TRJ                                                           #
#        TRACEF RETURN JUMP                                            #
KTRJ: 
         CALL  KY00  ;              #   FORCE  FULL WORD               #
#        FALL INTO  KB00/KC00                                          #
#        30  BIT MEM REF   SA,B,X - A,B,X + K                          #
#        30  BIT JUMPS                                                 #
KB00: 
KC00: 
#        NOP  IF ON LAST PARCEL                                        #
         IF PARCEL  EQ  3  THEN  CALL  KY00  ;
#        TEST FOR FULL BUFFER                                          #
         IF CFINX GT  ECF  THEN  CALL  KZ00  ;
#                                                                      #
KB10: 
         CF   [CFINX] =  0 ;
         CFOP [CFINX] =  MOP  [INX] ; 
         CFI  [CFINX] =  IDES [INX] ; 
         CFJ  [CFINX] =  JDES [INX] ; 
         CFKK [CFINX] =  KDES [INX] ; 
         TX = OPN1 [INX] ;
         IF XFRMD[INX] THEN                    #TRANSFORMED TO 30 BITS # LCMISC 
             BEGIN                                                       LCMISC 
             CFST[CFINX] = 0;                  #NEEDS NO ST INDEX      # LCMISC 
             GOTO KB498;                                                 LCMISC 
             END                                                         LCMISC 
         IF TX EQ 1 THEN CFST [CFINX] = TX ;
         IF KDES [INX] NE 0 THEN GOTO KB49  ;   # CDOCUMENT THIS       #
#                                                                      #
         IF  TX  GE 0  THEN 
KB12: 
                                                            BEGIN #1# 
                  CFST [CFINX]  =  TX  ;
                  GOTO KB49  ;
                                                            END   #1# 
#                                                                      #
KB15: 
         TX  =  BI - TX   ;         #   ADJUST TO ICFT                 #
         IF  OPCD [TX]  EQ  QICFOP"SUBS"  THEN
                                                            BEGIN #1# 
           TX  =  OPN1 [TX]  ;
           IF  TX  GE  0  THEN   GOTO   KB12 ;
         TX  =  BI - TX   ;         #   ADJUST TO ICFT                 #
                                                            END    #1#
#        MUST  BE OFFS                                                 #
KB20: 
#        ADD OFFSET                                                    #
         CFKK  [CFINX]  =  CFKK [CFINX] +  OPN2 [TX]  ; 
         TX  =  OPN1 [TX]  ;
         IF  TX GE  0  THEN  GOTO  KB12 ; 
#                                                                      #
KB49: 
         IF  MOP [INX]  EQ  QCFOP"TRJ"  THEN
                                                            BEGIN #1# 
                  CFOP [CFINX] = QCFOP"RJ"  ; 
                  GOTO KB495  ; 
                                                            END   #1# 
         IF  MOP [INX]  EQ  QCFOP"TIJP" THEN
                                                            BEGIN #1# 
                  CFOP [CFINX] = QCFOP"JP"  ; 
                  GOTO KB495  ; 
                                                            END   #1# 
         GOTO  KB498  ; 
KB495:  
         CFINX =  CFINX + 1 ; 
         IF  CFINX  GT  ECF  THEN  CALL KZ00 ;
                  CF   [CFINX] = 0 ;
                  CFOP [CFINX] = QCFOP"TRB" ; 
                  CFML [CFINX] = LINE  ;
                  CFST [CFINX] = MEP   ;
                  CFINX = CFINX + 1 ; 
                  CLC [0] = CLC [0] + 4 ; 
                  GOTO  KRT00 ; 
KB498:  
         CFINX =  CFINX + 1  ;
         CLC [0]  =  CLC [0] + 2  ; 
         IF  MOP [INX]  EQ  QCFOP"JP"  THEN  CALL KY00 ;
         IF  MOP [INX]  EQ  QCFOP"RJ"  THEN  CALL KY00 ;
         IF MOP [INX] NE QCFOP"EQ" THEN GOTO KB4985 ; 
         IF IDES [INX] + JDES [INX] EQ 0 THEN CALL KY00 ; 
KB4985: 
         GOTO  KRT00  ; 
#                                                                      #
#**********************************************************************#
#        LINE                                                          #
#        OPN1  IS LINE NUMBER                                          #
KK00: 
         IF CIDDB NQ 0 THEN                                              JUNK 
           BEGIN                                                         JUNK 
           CALL KY00;    # FORCE UPPER  #                                JUNK 
           CLC = CLC + 2;   # NOW ALLOW ENOUGH ROOM FOR SB0 B2+LINE      JUNK 
                              WHICH EDITOR WILL GENERATE #               JUNK 
                                                                         JUNK 
           END                                                           JUNK 
         IF  CFINX  GT ECF  THEN CALL  KZ00  ;
         CF   [CFINX] = 0 ; 
         CFOP [CFINX] =  QCFOP"LINE" ;
         CFML [CFINX] = OPN1 [INX] ;
         CFINX = CFINX + 1   ;
         GOTO  KRT00  ; 
#                                                                      #
#        LABEL                                                         #
KL00: 
#        LINK LABEL INTO CODE CHAIN                                    #
#        OPN1 IS S.T.P.  TO LABEL ENTRY                                #
KL01: 
         ASEQ [ LENT [CSLC]]  =  OPN1 [INX] ; 
         LENT [CSLC] =  OPN1 [INX] ;
         ASEQ [LENT [CSLC]] = 0  ;
#        FILL WORD WITH NOPS IF NECESSARY                              #
         IF NOT UNRLB [INX]  THEN CALL KY00   ; 
#        TEST FOR FULL  BUFFER                                         #
         IF  CFINX  GT  ECF  THEN  CALL KZ00  ; 
#                                                                      #
KL10: 
         CF   [CFINX] =  0 ;
         CFOP [CFINX] =  QCFOP"LABL"  ; 
         CFST [CFINX] =  OPN1 [INX] ; 
#        LOCATION                                                      #
         LOCN  [ OPN1 [INX] ]  =  WCLC [0]  ; 
         CFINX =  CFINX + 1  ;
         GOTO  KRT00  ; 
#                                                                      #
#**********************************************************************#
#        PRST     ENTRY WORD OF PROC                                   #
KP00: 
#        FORCE TO FULL WORD                                            #
         CALL  KY00  ;
         IF  CFINX GT  ECF - 2  THEN  CALL KZ00  ;
         CF   [CFINX] = 0  ;
         CFOP [CFINX] = QCFOP"PRST" ; 
         CF   [CFINX+1]  =  CFPS [ OPN1 [INX] ] ; 
         CFINX =  CFINX + 2  ;
         CLC [0]  =  CLC [0] + 4 ;  #   FULL WORD                      #
         GOTO  KRT00  ; 
#                                                                      #
#        SAVE  AND  TSSV                                               #
KS00: 
#        NOTE THE  TEST   TS00  ISL00                                  #
         IF  NOT AINVS [INX]  THEN GOTO KSXIT  ;
#        SAVED VALUE  LOADED                                           #
          $BEGIN
         NSSV  =  NSSV  + 1  ;      #   SAVES TO STORES                #
          $END
         IF   OPCD [INX]  EQ  QICFOP"SAVE"  THEN  GOTO KS20  ;
#        XMIT  XI  TO  XJ                                              #
KS15: 
         IF  CFINX  GT   ECF  THEN CALL KZ00  ; 
KS17: 
         CF   [CFINX]  = 0    ; 
         IF  OPCD [INX]  EQ  QICFOP"TSSV" THEN
                  CFOP [CFINX] = QCFOP"BXMT" ;    ELSE  #  COMP IN B   #
                  CFOP [CFINX] = QCFOP"XBPB" ;    # SXS BJ + B0        #
         CFI  [CFINX]  = JDES [INX] ;   #  REGJ  IS STORE REG          #
         CFJ  [CFINX]  = IDES [INX] ;   #  REGI  IS SOURCE REG         #
         CFINX =  CFINX + 1  ;
         CLC  [0]  =  CLC [0] + 1  ;
#        STORE  REGJ                                                   #
KS20: 
#        TEST FOR LAST PARCEL                                          #
         IF  PARCEL  EQ  3  THEN  CALL  KY00  ; 
#        TEST FOR BUFFER END                                           #
         IF  CFINX  GT ECF THEN CALL KZ00  ;
KS22: 
       CF  [CFINX]  =  0  ; 
         CFOP  [CFINX]  =  QCFOP"ABPK"  ; 
         CFI   [CFINX]  =  JDES [INX]  ;     #  X6, X7                 #
         CFST  [CFINX]  =  OPN1 [INX]  ;
         CLC  [0]  =  CLC [0]  +  2 ; 
         CFINX =  CFINX + 1  ;
KSXIT:  
         GOTO  KRT00   ;
#                                                                      #
#**********************************************************************#
#        TRC      TRACE PRESET                                         #
#        OPM  IS  S.T.P. TO  PROC                                      #
#        TAD GENERATES  (NAMEXYZLLL)                                   #
KT00: 
#        FORCE TO FULL  WORD                                           #
         CALL  KY00 ; 
         IF  CFINX  GT  ECF THEN CALL KZ00  ; 
         CF  [CFINX] = 0 ;
         CFOP [CFINX] =  QCFOP"TRC" ; 
         CFST [CFINX] =  OPN1 [INX] ; 
         CFINX =  CFINX + 1 ; 
         CLC [0] =  CLC [0] + 4 ;   #   FULL WORD                      #
         GOTO KRT00  ;
#                                                                      #
#        NULL  OPCODE                                                  #
KN00: 
         GOTO  KRT00  ;             #  SKIP  IT                        #
#        CNTL                                                          #
KD00: 
         GOTO  KRT00  ; 
#        RMRK                                                          #
KE00: 
         GOTO  KRT00  ; 
#        CMNT                                                          #
KF00: 
         GOTO  KRT00  ; 
#        FILL OUT CURRENT WORDS WITH NOPS IF NECESSARY                 #
#**********************************************************************#
CFWXIT: 
#                                                                      #
          $BEGIN
         IF  SKRMK  THEN  GOTO  CFWCM ; ELSE  GOTO  CFWXZ ; 
CFWCM:  
         IF  NOT  KERRY  THEN  GOTO  CFWXZ  ; 
         TCLOCK = TCLOCK  + CLOCK ; #   TOTAL CLOCK                    #
         TDLY  =  TDLY + SDLY  ;    #   TOTAL  ISUT DELAY              #
         NTNOP =  NTNOP + NSNOP  ;  #   TOTAL  NOPS                    #
         NTSV  =  NTSV + NSSV  ;    #   TOTAL  SAVES - STORES          #
         NTOR  =  NTOR + NSOR  ;    #   TOTAL OUT OF REGISTERS         #
         SQPC  =  CLC [0] - CLCI ;  #   SEQ  PARCEL COUNT              #
#        EDIT END OF SEQUENCE LINE                                     #
         CALL  EEOS00 ; 
#        COMMENT  CARD                                                 #
         IF  CFINX  GT  ECF - 10  THEN  CALL KZ00  ;
         CF  [CFINX]  =  CMCFC [0] ;
         CF  [CFINX + 1 ]  =  SDC [ 0 ] ; 
         CF  [CFINX + 2 ]  =  SDC [ 1 ] ; 
         CF  [CFINX + 3 ]  =  SDC [ 2 ] ; 
         CF  [CFINX + 4 ]  =  SDC [ 3 ] ; 
         CF  [CFINX + 5 ]  =  SDC [ 4 ] ; 
         CF  [CFINX + 6 ]  =  SDC [ 5 ] ; 
         CF  [CFINX + 7 ]  =  SDC [ 6 ] ; 
         CF  [CFINX + 8 ]  =  SDC [ 7 ] ; 
         CFINX = CFINX + 9  ; 
CFWXZ:  
          $END
         END      #       CFW00                                        #
CONTROL EJECT;
    PROC KY00     ; 
                                        #INSERTS AS MANY NOPS AS NEC-  #
                                        # ESSARY INTO THE CODE FILE    #
                                        # BUFFER UNTIL THE CURRENT     #
                                        # LOCATION COUNTER, CLC, IS ON #
                                        # PARCEL ZERO (WORD BOUNDARY). #
                                        # IF THE CLC IS ON A WORD      #
                                        # BOUNDARY, KY00 EXITS         #
                                        # IMMEDIATELY.                 #
         BEGIN    #      KY00                                          #
KY10: 
         IF  PARCEL  EQ  0  THEN   GOTO  KYXIT  ; 
          $BEGIN
         NSNOP =  NSNOP + 1 ;       #   NUMBER OF NOPS                 #
          $END
#                                                                      #
KY20: 
         IF  CFINX  GT ECF  THEN  CALL KZ00  ;
         CF  [CFINX]  = KFNOP [0]  ;
             IF B<1> PARCEL EQ 0 THEN   #EVEN PARCEL IN WORD# 
               BEGIN
               B<0,12>CF[CFINX] = SBI61;   #SB0 B0+04600  # 
               CFKK[CFINX] = O"46000";         #MAKE NOP MORE OBVIOUS  #
               CLC[0] = CLC[0] +1;
               END
         CFINX  =  CFINX + 1 ;
         CLC [0] = CLC [0] + 1 ;
         GOTO  KY10  ;
#                                                                      #
KYXIT:  
         END      #      KY00                                          #
CONTROL EJECT;
#**********************************************************************#
#                                                                      #
#        WRITE CODE FILE  BUFFER                                       #
         XDEF     PROC   KZ00  ;    #   WRITE THE CODE FILE BUFFER     #
#**********************************************************************#
    PROC KZ00     ; 
         BEGIN    #      KZ00                                          #
         CALL  PTCFL ( ACF, CFINX ) ; 
         CFINX =  0  ;
         END      #      KZ00                                          #
#**********************************************************************#
         END      #      CODGK2                                        #
         TERM 
