*DECK             KKCW
USETEXT   TSOURCE 
USETEXT   TCEXECQ 
USETEXT   TSYMCNS 
USETEXT   TCEXEC
USETEXT   TCOM37Q 
USETEXT   TCOM78Q 
USETEXT   TC7DECS 
  PROC   KKCW  ;
         BEGIN #    KKCW                                               #
#        DUMMY OUTER PROC TO DEFINE DATA                               #
  
  
  
  
*CALL COMEX 
  
  
  
         DEF GE #GQ#; 
         DEF LT #LS#; 
         DEF GT #GR# ;
         ITEM  KFBXY I; 
         ITEM  KNBXY I; 
         ITEM  KKON I ; 
         ITEM  KBBND  B  ;         #    BAD BOUNDARY                   #
         ITEM  KBMHT  B  ;         #    BIT MODIFIED H OR T            #
         ITEM  KVFLG  I  ;         #    VFLG [OBJX]                    #
         ITEM  KCTYP  I  ;         #    CTYP [OBJX]                    #
         ITEM  KWTYP  I  ;         #    CONTROL WORD TYPE              #
         ITEM  KLCOM  I  ;
         ITEM  KTRAD I ;
         ITEM  KTMPR I  ; 
         ITEM  KTTMP I ;
         ITEM KSUBS I  ;
ITEM KRP=0; 
         ITEM  KP1 I ;
         ITEM  KP2 I ;
         ITEM  KP3 I ;
         ITEM  KP4 I ;
#        CONTROL WORD TYPE                                             #
         ARRAY LCCW [0:7]  S(1) ; 
         BEGIN
          ITEM LCCWT I (0,0,60) = [ 0,3,7,5,2,6,4,1,1] ;
         END
#                                                                      #
#        LONG STRING CONTROL WORD                                      #
         ARRAY LCWR  [0:0]  S(1) ;
         BEGIN
         ITEM  CWSTY U (0,0,4)    , 
          CWFB  U  (0,4,11) , 
          CWNB  U  (0,15,9) , 
               CWOF  I (0,24,18)  , 
               CWRD  I (0,0,60)   , 
               CW42  I (0,0,42)   ; 
         END
         XREF FUNC ADCGEN;
         XREF PROC ADCON; 
         XREF PROC CALOC ;
         XREF PROC CLSS;
         XREF FUNC FADCON;
         XREF FUNC GETRD; 
         XREF PROC ICFGEN;
         XREF PROC ICFGNR;                                               JANDRE 
         XDEF FUNC INCRMT;                                               JANDRE 
         XDEF PROC KRL00 ;
         XDEF PROC KGT00; 
         XDEF PROC KRP00; 
      XDEF FUNC KCT00;
         XREF FUNC PSCPRC;
         XREF FUNC PSICON;
         XREF PROC SADCON;
          XREF PROC  SLOD;                                               PSRSURE
         XREF FUNC TMPGEN;
         XREF PROC TMPRLS;
CONTROL EJECT;
PROC KRP00((KRPL)); 
         BEGIN
         ITEM  KRPL  ;
         KTMPR = 0 ;
         KCW00 ( ROPD [KRPL] ) ;
         KP1 = KCWPT ;
         IF KTTMP NQ 0 THEN KTMPR = KTTMP ; 
         KCW00 ( LOPD [KRPL] ) ;
         KP2 = KCWPT ;
         SADCON ; 
         ADCON ( KP1, 0 ) ; 
         ADCON ( KP2, 0 ) ; 
         KP3 = FADCON ; 
         IF KRP    EQ 0 THEN
      KRP=PSCPRC("SYMSM$"); 
         ICFGEN ( QICFOP"PCAL", KRP   , KP3 ) ; 
         IF KTMPR NQ 0 THEN TMPRLS ( KTMPR ) ;
         END
CONTROL EJECT;
PROC KRL00((KCRL)); 
         BEGIN
         ITEM  KCRL  ;
         ITEM  KCMP    I = 0 ;
         KTMPR = 0 ;
         KCW00 ( LOPD [KCRL] ) ;
         IF KTTMP NQ 0 THEN KTMPR = KTTMP ; 
         KP1 = KCWPT ;
         KCW00 ( ROPD [KCRL] ) ;
         IF KTTMP NQ 0 THEN KTMPR = KTTMP ; 
         KP2 = KCWPT ;
         KP3 = PSICON (RSWP[RLTL[KCRL]]) ;
         SADCON ; 
         ADCON (KP1,0) ;
         ADCON (KP2,0) ;
         ADCON (KP3,0) ;
         KP4 = FADCON ; 
         IF KCMP   EQ 0 THEN
      KCMP=PSCPRC("SYMSC$");
         ICFGEN ( QICFOP"PCAL", KCMP  , KP4 ) ; 
          ICFGEN(QICFOP"DRV",0,XREG6);
         MEMR [KCRL] = ICFPTR ; 
         RLTL [KCRL] = QRLTL"NQ" ;
         IF KTMPR NQ 0 THEN TMPRLS ( KTMPR ) ;
         END
CONTROL EJECT;
  PROC   KGT00 ( KGT ) ;
         BEGIN
         ITEM  KGT I ;
         ITEM  KGTP I = 0 ; 
         KCW00 ( KGT ) ;
         SADCON ; 
         ADCON ( KCWPT, 0 ) ; 
         KP1 = FADCON ; 
         IF KGTP EQ 0 THEN
      KGTP=PSCPRC("SYMSG$");
         ICFGEN ( QICFOP"PCAL", KGTP, KP1 ) ; 
          ICFGEN(QICFOP"DRV",0,XREG6);
         END
#        CONSTRUCT LONG STRING CONTROL WORD                            #
CONTROL EJECT;
# MOVE STRING TO TEMP#
FUNC KCT00(KGT);
BEGIN 
ITEM KGT; 
KCW00(KGT); 
SADCON; 
ADCON(KCWPT,0); 
KP1=CWNB[0];
CWRD[0]=0;
IF KP1 EQ 0 THEN CWNB[0]=240; ELSE CWNB[0]=KP1; 
CWSTY[0]=O"7";
CWOF[0]=1;
KP2=TMPGEN((CWNB[0]+9)/10); 
KP3=ADCGEN(KP2,0);
POSI[KP3]=QPOSI"ALL"; 
INVR[KP3]=CW42[0];
ADCON(KP3,0); 
KP1=FADCON; 
IF KRP EQ 0 THEN KRP=PSCPRC("SYMSM$");
ICFGEN(QICFOP"PCAL",KRP,KP1); 
KCT00=KP2;
END 
CONTROL EJECT;                                                           JANDRE 
FUNC INCRMT(X);    # GIVES THE INCREMENT OF PARALLEL ITEMS #             JANDRE 
    BEGIN ITEM X;  # OBJECT TRIAD POINTER, BY VALUE #                    JANDRE 
         ITEM MEMROB;                                                    JANDRE 
         MEMROB=MEMR[X];                                                 JANDRE 
         IF          CLAS[MEMROB] EQ QCLAS"TITM"                         JANDRE 
            AND NOT PORS[MAMA[MEMROB]]                                   JANDRE 
         THEN INCRMT=TENT[MAMA[MEMROB]]; # PARALLEL #                    JANDRE 
         ELSE INCRMT=1;                  # SERIAL   #                    JANDRE 
    END # INCRMNT#                                                       JANDRE 
                                                                         JANDRE 
                                                                         JANDRE 
XDEF FUNC STRADR;                                                        JANDRE 
FUNC STRADR((TR),(PAS),(L));   # GIVE ADDRESS OF PASTH WORD OF STRING  #
BEGIN                                                                    JANDRE 
    ITEM TR, PAS; ITEM L B;                                              JANDRE 
    ITEM M; M=MEMR[TR];                                                  JANDRE 
    ITEM N; N=OFFS[TR];                                                  JANDRE 
    ITEM P; P=INDX[TR];                                                  JANDRE 
       IF NOT (PAS EQ 0 AND N EQ 0) THEN
         BEGIN                                                           JANDRE 
         N=N+PAS*INCRMT(TR);                                             JANDRE 
         ICFGEN(QICFOP"OFFS",M,N);                                       JANDRE 
         M=ICFPTR;                                                       JANDRE 
         END                                                             JANDRE 
    IF P NQ 0 THEN                                                       JANDRE 
         BEGIN                                                           JANDRE 
         ICFGEN(QICFOP"SUBS",M,P);                                       JANDRE 
         M=ICFPTR;                                                       JANDRE 
         END                                                             JANDRE 
     IF L THEN                                                           JANDRE 
         BEGIN                                                           JANDRE 
         ICFGEN(QICFOP"LOAD",M,0);                                       JANDRE 
         M=ICFPTR;                                                       JANDRE 
         END                                                             JANDRE 
    STRADR=M;                                                            JANDRE 
END                                                                      JANDRE 
CONTROL EJECT;
PROC KCW00((KOP));
         BEGIN #    KCW00                                              #
         ITEM MEMROB;                                                    JANDRE 
         ITEM KKMEMR I ;
         ITEM  KOP I ;
#        KOP IS TRIAD INDEX OF FUNI, PRIM OR SUBS                      #
#        REPRESENTING  SOURCE/SINK  OBJECT/SUBJECT                     #
#        OUTPUT IS KCWPT - A S.T.P. TO CONTROL WORD                    #
         ITEM TR1; #WORKING AREA #                                       JANDRE 
         KSUBS = 0 ;
         KTRAD = 0 ;
         KTTMP = 0 ;
         KKMEMR = 0 ; 
         KWTYP = 0 ;
         CWRD [0] = 0 ; 
         KBMHT = FALSE ;
         KBBND = FALSE ;
         IF MEMR [KOP] LT 0 THEN
         BEGIN
         OBJX = KOP ; 
         KT00 ; 
         END
               ELSE                                                      JANDRE 
         BEGIN                                                           JANDRE 
         CLSS (KOP) ;    #    GET STRUCTURE OF OPERAND                 #
         IF POTE[OBJX] NQ 0 THEN                                         JANDRE 
              BEGIN # C<10*E+ALPHA,BETA>   IPLUS TRIAD HAS BEEN DISCON-# JANDRE 
                    # NECTED DURING PHASBS - ADD ALPHA(FROM POTE[NBDX] # JANDRE 
                    # TO 10*E AS GENERATED DURING EXPGEN               # JANDRE 
                    TR1=POTE[OBJX];                                      JANDRE 
                    ICFGEN(QICFOP"ADSC",MEMR[LOPD[TR1]],POTE[NBDX]);     JANDRE 
                    MEMR[LOPD[TRX]]=ICFPTR;                              JANDRE 
              END                                                        JANDRE 
         IF WXSG [STRUC] THEN INDX [OBJX] = MEMR [WINX] ; 
         KSUBS = INDX [OBJX] ;
         IF KSUBS NQ 0 THEN            #   SUBSCRIPTED                 #
                                       BEGIN #1#
           IF STRUC LQ QCLSS"B" THEN
                                       BEGIN #2#
                   STRUC = QCLSS"B" ; 
                   GOTO KCW035 ;
                                       END   #2#
           IF STRUC LQ QCLSS"D" THEN
                                       BEGIN #2#
                   STRUC = QCLSS"D" ; 
                   GOTO KCW035 ;
                                       END   #2#
                                       END   #1#
         IF FPRI[MEMR[OBJX]] NQ S"NULL" THEN     BEGIN#1# 
              IF STRUC EQ QCLSS"A" THEN          BEGIN#2# 
                   KKMEMR = MEMR[OBJX] ;
                   STRUC = QCLSS"B" ; 
                   GOTO KCW035 ;                 END#2# 
              IF STRUC EQ QCLSS"C" THEN          BEGIN#2# 
                   KKMEMR = MEMR[OBJX] ;
                   STRUC = QCLSS"D" ;            END#2# 
                                                 END#1# 
         END # MEMR[KOP] #                                               JANDRE 
KCW035: 
         KVFLG = VFLG [OBJX] ;
         KCTYP = CTYP [OBJX] ;
#        COMPUTE CONSTANT OFFSET                                       #
         CWOF[0]=INCRMT(OBJX);                                           JANDRE 
#        ESTABLISH TYPE  INITIALLY  0,1,2,3 = B,O,H,T                  #
         IF KVFLG EQ QVFLG"LITR" OR KFLG [OBJX] THEN
                   KWTYP = KCTYP +1 ;   # O,H,T  = 1,2,3               #
         IF FNUM[KOP] EQ S"BYTE"  THEN  KWTYP=2;
         IF KFLG [OBJX] THEN GOTO KCW07 ; 
         IF KVFLG NQ QVFLG"LITR" THEN   #    BINARY                    #
                                                       BEGIN #1#
KCW065: 
               CWFB [0] = EFBT [OBJX] ;      #    FIRST BIT            #
               CWNB [0] = ENBT [OBJX] ;      #    NUMBER BITS          #
               GOTO KCW10 ; 
                                                       END   #1#
#        O,H,T                                                         #
KCW07:  
         IF STRUC GE QCLSS"C" THEN      #  C,D,E,H                     #
                                                            BEGIN #1# 
              IF FNUM[KOP] EQ S"BIT" THEN  #BIT(H,T)#                    JANDRE 
                                                            BEGIN #2# 
                    KWTYP = 0 ; 
                    KBMHT = TRUE ;
                    GOTO KCW065;                                         JANDRE 
                                                            END   #2# 
                                                            END   #1# 
#        H OR T NOT BIT MODIFIED   ( BYTE OR BITY )                    #
         IF EFBY [OBJX] * 6 NQ EFBT [OBJX] THEN   #  BAD BOUNDARY      #
                                                       BEGIN #1#
               KWTYP = KWTYP + 3 ;           # 1,2,3 - 4,5,6           #
               KBBND = TRUE ; 
               GOTO KCW065 ;
                                                       END   #1#
#        H OR T ON BYTE BOUNDARY OR  OCTAL CONSTANT                    #
         CWFB [0] = EFBY [OBJX] ;  #    FIRST BYTE                     #
         CWNB [0] = ENBY [OBJX] ;  #    NUMBER OF BYTES                #
#        TEST SPECIFICALLY HERE FOR B-MODIFICATION AND                 #
#        SET NBITS/NBYTS = 0  IN THE CONTROL WORD                      #
KCW10:  
         IF STRUC GE QCLSS"C" THEN CWNB [0] = 0 ; # NUMBER BITS/BYTES  #
         CWSTY [0] = LCCWT [KWTYP] ;    # TRANSFORM FROM 0,1,2,3-4,5,6 #
         IF  LEVL[MEMR[OBJX]]  NQ QLEVEL"LEV1"  THEN                     LARRY-R
           B<0> CWSTY[0] = 1;  # MARK LCM RES  #                         LARRY-R
         IF STRUC EQ QCLSS"A" THEN GOTO KCW20 ; 
          IF STRUC NQ QCLSS"B" THEN GOTO KCW40;                          PSRSURE
                               ELSE  GOTO KCW25;                         PSRSURE
#        CONSTANT CONTROL WORD                                         #
KCW20:  
          IF BASD[OBJX] THEN GOTO KCW25;                                 PSRSURE
         KCWPT = ADCGEN ( MEMR [OBJX], OFFS [OBJX]) ; 
         POSI [KCWPT] = QPOSI"ALL" ;
         INVR [KCWPT] = CW42 [0] ;
         RETURN;                                                         JANDRE 
#        SUBSCRIPTED                                                   #
#        KLCOM AND KCWPT ARE SET UP                                    #
KCW25:  
          KLCOM = PSICON(CWRD[0]);                                       PSRSURE
          KCWPT = TMPGEN(1);                                             PSRSURE
KCW251:                                                                  PSRSURE
          SLOD(OBJX);                                                    PSRSURE
          ICFGEN(QICFOP"LOC",MEMR[OBJX],0);                              PSRSURE
KBS27:  
         ICFGEN (QICFOP"LOR", ICFPTR, KLCOM ) ; 
         ICFGEN (QICFOP"REPL", KCWPT, ICFPTR) ; 
         RETURN;                                                         JANDRE 
#        BIT/BYTE MODIFIED    C,D, E, H                                #
KCW40:  
         IF KFLG[FBDX] THEN   #    CONSTANT FIRST BYTE                 #
                                                       BEGIN #1#
               KKON  = KONS [FBDX]  ; 
               IF ( KBMHT AND STRUC GT QCLSS"D" ) OR
                  KBBND THEN KKON = KKON * 6 ;
               CWFB [0] = CWFB [0] + KKON ; 
                                                       END   #1#
         IF KFLG [NBDX] THEN  #    CONSTANT NUMBER OF BITS/BYTES       #
                                                       BEGIN #1#
               KKON = KONS [NBDX] ; 
               IF KBBND THEN KKON = KKON * 6  ; 
               CWNB [0] = KKON ;
               IF NOT KBBND 
               AND FNUM[KOP] EQ S"BYTE" 
               AND KLSS[KOP] NQ S"SINK" 
               THEN 
               KKON = KKON*6; 
               ENBT[KOP] = KKON;
                                                       END   #1#
      ELSE
      BEGIN 
      VLNG[KOP]=T;
      ENBY[KOP]=MEMR[NBDX]; 
      END 
         IF KFLG [FBDX] AND KFLG [NBDX] THEN #  F AND N CONSTANT       #
                                                       BEGIN #1#
          IF STRUC EQ QCLSS"C" THEN GOTO KCW20 ;
          IF STRUC EQ QCLSS"D" THEN     BEGIN #2# 
#        SUBSCRIPTED - POST CONSTANT AND GET TEMP FOR CONTROL WORD     #
         GOTO  KCW25 ;
                                        END   #2# 
                                                       END   #1#
#        F AND/OR N VARIABLE                                           #
      IF STRUC EQ QCLSS"C" THEN 
#                                       UNSUBSCRIPTED                  #
          IF NOT BASD[OBJX] THEN
                                                            BEGIN #1# 
               KLCOM = ADCGEN (MEMR [OBJX], OFFS [OBJX] ) ; 
               POSI [KLCOM] =  QPOSI"ALL" ; 
               INVR [KLCOM] =  CW42 [0] ; 
               KCWPT = TMPGEN (1) ; 
               KFBXY = MEMR [FBDX] ;
               IF NOT KFLG [FBDX] THEN KCW60 ;
               KNBXY = MEMR [NBDX] ;
      IF NOT KFLG[NBDX] THEN KCW70; 
               ICFGEN (QICFOP"REPL", KCWPT, ICFPTR ) ;
               RETURN;                                                   JANDRE 
                                                            END   #1# 
#        SUBSCRIPTED                                                   #
            #          OR BASED   # 
         KCWPT = TMPGEN (1) ; 
         KLCOM = PSICON (CWRD [0]) ;
         KFBXY = MEMR [FBDX] ;
         IF NOT KFLG [FBDX] THEN KCW60 ;
         KNBXY = MEMR [NBDX] ;
      IF NOT KFLG[NBDX] THEN KCW70; 
      GOTO   KCW251;                                                     PSRSURE
#                                                                      #
         END   #    KCW00                                              #
#        CONSTANT FBDY                                                 #
CONTROL EJECT;
   PROC  KCW60  ; 
         BEGIN #    VARIABLE FIRST BIT/BYTE                            #
         IF NOT KBBND THEN    # GOOD BIT/BYTE BOUNDARY                 #
         ICFGEN (QICFOP"LSHC", KFBXY, 45 )  ; 
         ELSE                                                            JANDRE 
#        BAD BYTE BOUNDARY  MULTIPLY BYTE BY 6                         #
         BEGIN                                                           JANDRE 
         ICFGEN (QICFOP"IADD",  KFBXY     ,   KFBXY     ) ; #  *2      #
         ICFGEN (QICFOP"IADD",  KFBXY     , ICFPTR ) ; #  *3           #
         ICFGEN (QICFOP"LSHC", ICFPTR, 46 )  ;   #    *6               #
         END                                                             JANDRE 
         ICFGEN(QICFOP"IADD",ICFPTR,KLCOM);                              JANDRE 
         KLCOM = ICFPTR ; 
         END   #    VARIABLE FIRST BIT/BYTE                            #
#        VARIABLE NUMBER OF BITS OR BYTES                              #
CONTROL EJECT;
   PROC  KCW70 ;
         BEGIN #    VARIABLE NUMBER OF BITS                            #
         IF NOT KBBND THEN
               ICFGEN (QICFOP"LSHC",  KNBXY     , 36 ) ;
         ELSE                                                            JANDRE 
#        BAD BYTE BOUNDARY  MULTIPLY BYTE BY 6                         #
         BEGIN                                                           JANDRE 
         ICFGEN (QICFOP"IADD", KNBXY, KNBXY )  ;
         ICFGEN (QICFOP"IADD",  KNBXY     , ICFPTR ) ;
         ICFGEN (QICFOP"LSHC", ICFPTR, 37 ) ; 
         END                                                             JANDRE 
         ICFGEN(QICFOP"IADD",ICFPTR,KLCOM);                              JANDRE 
         KLCOM = ICFPTR ; 
         END   #    VARIABLE NUMBER OF BITS/BYTES                      #
#        OPERAND IS A COMPUTATION  (MEMR [OBJX])                       #
CONTROL EJECT;
  PROC   KT00  ;
         BEGIN
         KTRAD = GETRD ;
         KTTMP = TMPGEN (1) ; 
         MEMR [KTRAD] = KTTMP ; 
         ICFGEN ( QICFOP"REPL", KTTMP, MEMR [OBJX] ) ;
         IF ENBT [OBJX] EQ 0 THEN 
         BEGIN
         ENBT [KTRAD] = 60 ;
         ENBY [KTRAD] = 10 ;
         END
              ELSE                                                       JANDRE 
         BEGIN                                                           JANDRE 
         ENBT [KTRAD] = ENBT [OBJX] ; 
         ENBY [KTRAD] = ENBY [OBJX] ; 
       IF NOT ADJF[OBJX] THEN 
       BEGIN
         EFBT [KTRAD] = 60 - ENBT [KTRAD] ; 
         EFBY [KTRAD] = 10 - ENBY [KTRAD] ; 
       END # ELSE EFBT=0 AND EFBY=0 FOR LEFT ADJUSTED DATA# 
         END                                                             JANDRE 
         VFLG [KTRAD] = VFLG [OBJX] ; 
         CTYP [KTRAD] = CTYP [OBJX] ; 
         CLSS ( KTRAD ) ; 
         END
         END   #    KKCW                                               #
         TERM 
