*DECK C$KYDEF 
          IDENT  C$KYDEF
          ENTRY  C.KYDEF
          COMMENT  KEY DEFINITION FOR AK FILES
          SST 
*   THIS ROUTINE SETS KEY INFORMATION FOR AN ALTERNATE KEY (MIP)
*   FILE.  IT SETS THE KEY OF REFERENCE TO THE PRIMARY KEY AND CALLS
*   RMKDEF TO SET UP MIP WITH KEY INFO. 
* 
*   ENTERED WITH A0 = FIT.
*   ALL REGISTERS EXCEPT B1 AND A0 DESTROYED
* 
*   IT ASSUMES THAT THE PARAMETERS TO RMKDEF ARE IN THE ORDER FIT,
*   RKW,RKP,KL,KI,KF,KS,KG,KC,NL,IE,CH. 
*CALL IOMICROS
*CALL IODEFSC 
* 
          LDSET  LIB=BAMLIB  FOR RMKDEF 
 C.KYDEF  DATA   0
 CDCS     IFNE   OP.DCS,OP.NO 
          FETCH  A0,DBFO,X4 
          NZ     X4,C.KYDEF  JUMP IF I/O VIA CDCS (CDCS DOES KEYDEF)
 CDCS     ENDIF 
          RJ     =XC.SVRTN   STACK RETURN IN CASE OF ANY DIAGS
          SB3    B0          SET FOR PRIME KEY
          RJ     =XC.SETKY   SET UP PRIME KEY AS KEY OF REF 
          SX6    A0 
          SA6    =XC.BUFF    SET UP CALL - FIT
          FETCH  A0,KEYT,X4  GET KEY TABLE POINTER
          FETCH  A0,ORG,X5   GET OLD/NEW ORG FLAG 
          PL     X5,TSTFO    JP IF ORG IS OLD (PRE 2.0) 
          SX4    X4+2        IGNORE PRIME KEY FOR RMKDEF ORG NEW
          EQ     KYDFLOP
 TSTFO    BSS    0
          FETCH  A0,FO,X5    GET FILE ORG 
          SX5    X5-#AK#
          NZ     X5,KYDFLOP  JUMP IF NOT AN ACTUAL KEY FILE 
*      THIS IS NEEDED BECAUSE MIP NEEDS DIFFERENT INFO THAN AK DOES 
          SA4    X4          GET FIRST KEY DESCRIPTION
          MX5    60-#KKLS#
          SX6    10 
          LX6    60-#KWNS#-#KBCS#-#KKLS#   POSTION AT LENGTH
          LX5    60-#KWNS#-#KBCS#-#KKLS#
          BX4    X5*X4
          BX4    X4+X6       MIP REQUIRES SIZE TO BE 10 
          EQ     KYDFL1      GO SEND IT TO RMKYDEF
 KYDFLOP  BSS    0
          SA4    X4          FIRST ENTRY
          NZ     X4,KYDFL1   JP IF NOT DONE 
          RJ     =XC.GETRT   REMOVE LAST ENTRY FROM STACK 
          EQ     C.KYDEF
 KYDFL1   BSS    0
          SX6    A4+2        NEXT POINTER 
          SA6    =SSAVEPTR   SAVE IT
          SX6    A0          FIT ADDRESS
          SA6    PARAML      FIT ADDR TO PARAM LIST 
          LX4    #KWNS#      POSITION RKW 
          MX5    60-#KWNS#
          BX7    -X5*X4 
          SA7    =XC.BUFF+1  RKW TO LIST
          LX4    #KBCS#      RKP (BCP)
          MX5    60-#KBCS#
          BX6    -X5*X4 
          SA6    A7+B1       RKP TO LIST (BCP)
          LX4    #KKLS# 
          MX5    60-#KKLS#
          BX7    -X5*X4 
          SA7    A6+B1       KL (LENGTH)
          LX4    #KKIS# 
          MX5    60-#KKIS#
          BX6    -X5*X4 
          SA6    A7+B1       KI - ALWAYS ZERO 
          LX4    #KTYP# 
          MX5    60-#KTYP#
          BX7    -X5*X4 
          SA7    A6+B1       KF - KEY FORMAT
          LX4    #KKSS# 
          MX5    60-#KKSS#
          BX3    -X5*X4 
          SX6    1RU         UNIQUE 
          SX5    X3-#KSU# 
          ZR     X5,KYDF2    JP IF UNIQUE 
          SX6    1RF         FIFO 
          SX5    X3-#KSF# 
          ZR     X5,KYDF2    JP IF FIFO 
          SX6    1RI         MUST BE INDEXED
 KYDF2    BSS    0
          LX6    54          POSITION AT LEFT END 
          SA6    A7+B1       KS - KEY SUBSTRUCTURE
          LX4    #KKGS# 
          MX5    60-#KKGS#
          BX7    -X5*X4 
          SA7    A6+B1       KG - REPEATING GROUP SIZE
          LX4    #KKCS# 
          MX5    60-#KKCS#
          BX6    -X5*X4 
          SA6    A7+B1       KC - REPEATING GROUP COUNT 
          MX7    0
          SA4    A4+B1       GET WORD 2 (SPARSE KEY INFO) 
          BX0    X4          SAVE OMIT FLAG 
          LX4    #KOMT# 
          LX4    #KUSE#+#KSPA#+#KZER# 
          MX5    60-#KSPA#-#KZER# 
          BX5    -X5*X4 
          ZR     X5,KYDF3    JP IF NOT OMIT SPACES OR ZEROS 
          SX7    1RN         SET TO NOT RECORD NULL KEYS
          LX7    54 
 KYDF3    BSS    0
          SA7    A6+B1       NL - SPARSE KEY FLAG 
          MX6    0
          LX4    #KDN#+#KLEN# 
          MX5    -#KLEN#
          BX5    -X5*X4      GET LITERAL LENGTH (IF ANY)
          ZR     X5,KYDF4    JP IF NO LITERAL 
          SX6    1RI         SET TO INCLUDE 
          PL     X0,KYDF4    JP IF OMITTED NOT GIVEN
          SX6    1RE         SET TO EXCLUDE 
 KYDF4    BSS    0
          LX6    54 
          SA6    A7+B1       IE - SPARSE KEY INFO 
          NZ     X5,KYDF5    JP IF LITERAL SPECIFIED
          MX7    0
          SA7    A6+B1       NO LIT - ZERO OUT LAST WORD
          EQ     KYDF7       GO CALL RMKDEF 
 KYDF5    BSS    0
          SB2    X5          SAVE LENGTH OF LITERAL 
          LX4    #KBCP# 
          MX5    -#KBCP#
          BX5    -X5*X4      GET BCP OF LITERAL 
          SB3    X5          SAVE BCP 
          SA4    A4          GET WORD AGAIN 
          SA2    X4          GET FIRST WORD OF LITERAL
          SB4    10 
          SA7    A6+B1       SET A7 
          SB5    A6+B1       POINT TO FIRST PLACE TO STORE
 KYDSTLP  BSS    0
          LT     B2,B4,KYDEN1      JP IF LESS THAN A WORD LEFT
          SB2    B2-B4       DECREMENT CHAR COUNT 
          BX7    X2 
          SA7    B5          STORE A WORD OF CHARS
          SB5    B5+B1       BUMP POINTER 
          SA2    A2+B1       GET NEXT WORD OF LITERAL 
          EQ     KYDSTLP
 KYDEN1   BSS    0
          SX3    B4-B2       10 - CHARS LEFT
          SX4    6
          IX3    X4*X3       BITS LEFT
          SX5    59 
          IX3    X5-X3       BITS TO SHIFT
          SB6    X3 
          MX5    1
          AX5    X5,B6       MAKE MASK
          BX7    X5*X2       MASK OFF CHARS 
          SA7    B5          STORE LAST WORD OF CHARS WITH BIN ZERO FILL
 KYDF7    BSS    0
          SA1    PARAML 
          RJ     =XRMKDEF    DO CALL TO RMKDEF
          SB1    1           RESTORE B1 
          SA4    SAVEPTR     GET POINTER
          EQ     KYDFLOP
 PARAML   VFD    42/0,18/=XC.BUFF  PARAMETER LIST FOR RMKDEF
          VFD    42/0,18/=XC.BUFF+01  RKW 
          VFD    42/0,18/=XC.BUFF+02  RKP 
          VFD    42/0,18/=XC.BUFF+03  KL
          VFD    42/0,18/=XC.BUFF+04  KI
          VFD    42/0,18/=XC.BUFF+05  KF
          VFD    42/0,18/=XC.BUFF+06  KS
          VFD    42/0,18/=XC.BUFF+07  KG
          VFD    42/0,18/=XC.BUFF+08  KC
          VFD    42/0,18/=XC.BUFF+09  NL
          VFD    42/0,18/=XC.BUFF+10  IE
          VFD    42/0,18/=XC.BUFF+11  CH
          DATA   0           LIST TERMINATOR
          END 
