*DECK MIPGEN                                                             MIPGEN 
          IDENT  MIPGEN                                                  MIPGEN 
          ENTRY  MIPGEN                                                  MIPGEN 
          LCC    OVERLAY(MIPGEN,0,0)                                     MIPGEN 
SORT45    MICRO  1,1,*"PCOMMENT"
SORT45    SET    "SORT45" 
*                                                                        MIPGEN 
          LIST   -L,-R       AAMCOMCMP                                   MIPGEN 
*CALL AAMCOMCMP                                                          MIPGEN 
          LIST   *                                                       MIPGEN 
 #MIPGN#  MICRO   1,,/0,31B,1,53,0,1/                                    CIM0415
*                                                                        MIPGEN 
 FO'IS    EQU    3                                                       MIPGEN 
 FO'FIFO  EQU    7                                                       MIPGEN 
*                                                                        MIPGEN 
 PASSRJ   MACRO  TARGET                                                  MIPGEN 
          LOCAL RETURN                                                   MIPGEN 
          SA2    RETURN                                                  MIPGEN 
          SA3    TARGET+#PLAO#
          BX7    X2                                                      MIPGEN 
          SB2    X3                                                      MIPGEN 
          LX7    30                                                      MIPGEN 
          SA7    X3                                                      MIPGEN 
 RETURN   JP     B2+1                                                    MIPGEN 
 -        EQ     *+1                                                     MIPGEN 
 PASSRJ   ENDM                                                           MIPGEN 
PASSLOC   MACRO                                                          JJJ0529
PLIF      IFEQ   #PLAO#,1 
          VFD    12/24B 
PLIF      ELSE
          VFD    12/21B 
PLIF      ENDIF 
          VFD    12/ENDPL-*-1,36/0
          ENDM                                                           JJJ0529
                                                                         JJJ0529
                                                                         JJJ0529
PASS      MACRO  A,B                                                     JJJ0529
          VFD    42/0L_A                                                 JJJ0529
          IFEQ   #PLAO#,1,2                                              JJJ0529
          VFD    18/0                                                    JJJ0529
          VFD    42/0                                                    JJJ0529
IF1       IFC    EQ,*B**                                                 JJJ0529
          VFD    18/=Y_A                                                 JJJ0529
IF1       ELSE                                                           JJJ0529
          VFD    18/0                                                    JJJ0529
IF1       ENDIF                                                          JJJ0529
                 ENDM                                                    JJJ0529
*                                                                        MIPGEN 
 PRIMKEY  BSSZ   26                                                      MIPGEN 
 KEYHOLE  BSSZ   78                                                      MIPGEN 
 HEADER   DATA   20H1  MIPGEN DIRECTIVES
 DISP     DATA   10H
 CREC     BSSZ   9                                                       CY209
FO        MICRO  1,,*IS*                                                 MIPGEN 
 SAMFILE  FILE   LFN=SAMFILE,XN=INDEXF,FO="FO",DX=SAM$END,WSA=KEYHOLE,KA CIM0310
,=PRIMKEY,DFC=1,ORG=NEW,ERL=1 
 INPUT    FILE   LFN=INPUT,FO=SQ,WSA=CREC,BT=C,RT=Z,FL=90                CY209
 OUTPUT   FILE   LFN=OUTPUT,FO=SQ,WSA=DISP,BT=C,RT=Z,FL=100,PD=OUTPUT    CY209
PASL      PASSLOC                                                        JJJ0529
          ECHO   1,RTN=(MGGT,MGKD,MGMG,MGPT)                             JJJ0529
RTN       PASS   RTN_$MP,0                                               JJJ0529
          PASS   SAM$END                                                 CIM0303
ENDPL     BSS    0                                                       JJJ0529
GPNM      VFD    42/0LAAM$CTL,18/20                                      JJJ0529
          LIST   *                                                       JJJ0529
 CPNM     DATA   0LMPGN$MP                                               GBK0127
 LIBS     DATA   0LAAMLIB                                                GBK0127
          DATA   0                                                       MIPGEN 
 PLCS     VFD    42/0,18/PASL                                            MIPGEN 
          DATA   0                                                       MIPGEN 
 TENTHC   DATA   52429       USED TO DIVIDE BY TEN                       JJJ0311
 ALTKEYW  BSS    1           STORAGE FOR MAX ALTKEY WORD LENGTH          JJJ0311
*                                                                        MIPGEN 
          TITLE  MIPGEN-INDEX FILE CREATOR                               JJJ1129
*                                                                        JJJ1129
*#                                                                       JJJ1129
*1CD      MIPGEN - INDEX FILE CREATION/UPDATE UTILITY.                   JJJ1129
*0CD      FUNCTION                                                       JJJ1129
*         GENERATES AN INDEX FILE FOR ALTERNATE KEY ACCESS OF AN         JJJ1129
*         EXISTING AAM 2.0 IS, DA, OR AK FILE.  MIPGEN CAN ALSO BE USED  JJJ1129
*         TO ADD AND DELETE ALTERNATE KEYS FOR AN EXISTING INDEX FILE.   JJJ1129
*0CD      ENTRY CONDITIONS                                               JJJ1129
*         - THE FORMAT OF THE CONTROL STATEMENT CALL IS:                 JJJ1129
*           MIPGEN(PRIFILE,DIRFILE,LSTFILE)                              JJJ1129
*             PRIFILE - LFN OF EXISTING IS, DA, OR AK FILE; DEFAULT IS   JJJ1129
*                       SAMFILE.                                         JJJ1129
*             DIRFILE - OPTIONAL LFN OF FILE CONTAINING THE -RMKDEF-     JJJ1129
*                       DIRECTIVES; DEFAULT IS -INPUT-.                  JJJ1129
*             LSTFILE - OPTIONAL LFN OF FILE TO CONTAIN MIPGEN OUTPUT;   JJJ1129
*                       DEFAULT IS -OUTPUT-.                             JJJ1129
*           A FOURTH PARAMETER CAN ALSO BE USED -- IF THIS IS -ABT- 
*             FOR EXAMPLE    MIPGEN(BIGFILE,INPUT,OUTPUT,ABT) 
*             THEN IF MIPGEN DOES NOTHING BECAUSE OF A BAD RMKDEF 
*             STATEMENT, AND GIVES THE MESSAGE
*               *BAD RMKDEF CARD* 
*             IT WILL EXIT WITH AN ABORT RATHER THAN AN ENDRUN. 
*             NOTE THAT THE SECOND AND THIRD PARAMETERS CANT BE LEFT
*             TO DEFAULT TO INPUT AND OUTPUT. IF YOU USE THE 4TH, YOU 
*             HAVE TO STATE THE 2ND AND 3RD EXPLICITLY. 
*         - A MIPGEN JOB ALSO REQUIRES:                                  JJJ1129
*           A -FILE- CONTROL STATEMENT TO IDENTIFY THE FILE              JJJ1129
*           ORGANIZATION OF THE EXISTING IS, DA, OR AK FILE (DEFAULT IS  JJJ1129
*           FO=IS) AND THE -XN- PARAMETER SPECIFING THE NAME OF THE      JJJ1129
*           INDEX FILE (DEFAULT IS XN=INDEXF). AND AN INPUT FILE         JJJ1129
*           CONTAINING A SET OF -RMKDEF- DIRECTIVES DISCRIBING THE       JJJ1129
*           ALTERNATE KEYS.                                              JJJ1129
*0CD      EXIT CONDITIONS                                                JJJ1129
*         - THE INDEX FILE IS GENERATED OR UPDATED.                      JJJ1129
*         - THE RMKDEF DIRECTIVES ARE WRITTEN TO THE OUTPUT FILE.        JJJ1129
*         - MESSAGE -MIPGEN COMPLETE- WRITTEN TO USERS DAYFILE.          JJJ1129
*0CD      ERROR CONDITIONS                                               JJJ1129
*         ALL ERROR MESSAGES ARE WRITTEN TO THE USERS DAYFILE.  MIPGEN   JJJ1129
*         ISSUES EC115 (OUTSTANDING FATAL ERROR ON FILE) AND ISSUES A    JJJ1129
*         -BAD RMKDEF- MESSAGE FOR SYNTAX ERRORS IN THE RMKDEF           JJJ1129
*         DIRECTIVES (THE BAD DIRECTIVE IS ALSO ECHOED TO THE DAYFILE).  JJJ1129
*         MIPGEN ALSO ISSUES AN -UNABLE TO LOAD CAPSULE- MESSAGE WHEN    JJJ1129
*         -FDL.LDC- HAS BEEN UNABLE TO LOAD AAM MIP CAPSULE -MPGN$MP-.   JJJ1129
*         MIPGEN TERMINATES AFTER ANY OF THESE ERRORS.                   JJJ1129
*0CD      CALLED ROUTINES                                                JJJ1129
*         FDL.LDC - LOADS MIP CAPSULE -MPGN$MP-.                         JJJ1129
*         RMKDEF  - FTNIF ROUTINE THAT PROCESSES THE RMKDEF PARAMETERS   JJJ1129
*                   AND CALLS KDEF$MP (AAM MIP ROUTINE) WHICH WRITES     JJJ1129
*                   LEVEL 1 OF THE INDEX FILE.                           JJJ1129
*         MGPT$MP - AAM MIP ROUTINE THAT BUILDS THE -SORT RECORDS- FROM  JJJ1129
*                   THE DATA RECORDS AND THE ALTKEYDEFS.                 JJJ1129
*         SORT    - ORDERS THE -SORT RECORDS-.                           JJJ1129
*         MGGT$MP - AAM MIP ROUTINE THAT WRITES LEVELS 2 AND 3 OF THE    JJJ1129
*                   INDEX FILE.                                          JJJ1129
*0CD      DESCRIPTION                                                    JJJ1129
*         - PROCESS MIPGEN CONTROL STATEMENT PARAMETERS.                 JJJ1129
*         - TRANSFER TO -FDL.LDC- TO LOAD AAM MIP CAPSULE -MPGN$MP-.     JJJ1129
*           ERROR IF LOAD IS UNSUCCESSFUL.                               JJJ1129
*         - OPEN THE INPUT, OUTPUT, AND DATA FILE.                       JJJ1129
*         - WRITE TIME AND DATE HEADER TO THE OUTPUT FILE.               JJJ1129
*         - READ -RMKDEF- DIRECTIVE, ECHO TO OUTPUT FILE, CRACK THE      JJJ1129
*           PARAMETERS INTO A FTN APLIST FOR FTNIF ROUTINE -RMKDEF- TO   JJJ1129
*           PROCESS, AND RJ TO -RMKDEF-.  REPEAT UNTIL END OF            JJJ1129
*           DIRECTIVES.                                                  JJJ1129
*         - CLOSE INPUT AND OUTPUT FILE.                                 JJJ1129
*         - CHECK FOR ERROR 115B WHICH IS A CHECK FOR A FATAL ERROR      JJJ1129
*           GENERATED BY THE PROCESSING OF THE LAST RMKDEF DIRECTIVE.    JJJ1129
*           ERRORS GENERATED BY THE PROCESSING OF THE OTHER DIRECTIVES   JJJ1129
*           ARE CAUGHT BY A CHECK IN -RMKDEF-.                           JJJ1129
*         - CHECK FSTT, IF ALL ALTKEYS WERE DELETED THEN ZERO            JJJ1129
*           -FSMIPWORD- AND END.                                         JJJ1129
*         - COMPUTE MAXIMUM LENGTH OF -SORT RECORD-, MAXIMUM NUMBER OF   JJJ1129
*           WORDS NEEDED FOR ALTKEY, AND SET -FAPKY3ADR-, ALL IN         JJJ1129
*           PREPARATION FOR -SORT-.  THE FORMAT OF THE -SORT RECORD- IS  JJJ1129
*           (ALTKEY DEF/ALTKEY VALUE/PRIMKEY VALUE).                     JJJ1129
*         - TRANSFER TO -SORT-.                                          JJJ1129
*         - WHEN -SORT- IS READY FOR A -SORT RECORD- TRANSFER TO         JJJ1129
*           -MIPGEN- LABEL -PUTREC-.  AT -PUTREC- TRANSFER TO -MGPT$MP-  JJJ1129
*           TO BUILD THE -SORT RECORD- FROM THE ALTKEY DEF AND THE DATA  JJJ1129
*           FILE RECORDS.  ON RETURN TO -MIPGEN-, SET UP RECORD POINTERS JJJ1129
*           FOR -SORT- AND TRANSFER BACK TO -SORT-.  THIS LOOP BETWEEN   JJJ1129
*           -SORT- AND -PUTREC- IS CONTINUED UNTIL -MGPT$MP- DETECTS THE JJJ1129
*           END OF THE -SORT RECORDS-.  THEN -MGPT$MP- TRANSFERS TO      JJJ1129
*           -MIPGEN- LABEL -SAM$END-.  AT -SAM$END- TRANSFER TO -SORT,S- JJJ1129
*           RETURN ADDRESS +3 WHICH INDICATES TO -SORT- THE END OF THE   JJJ1129
*           RECORDS.                                                     JJJ1129
*         - -SORT- THEN ORDERS THE RECORDS BY ALTKEY DEF, ALTKEY VALUE,  JJJ1129
*           AND PRIMKEY VALUE BECAUSE THE ENTIRE RECORD IS THE SORTING   JJJ1129
*           KEY.  THE SORTING IS DONE TO MAKE SURE THE INDEX FILE IS AS  JJJ1129
*           COMPACT AS POSSIBLE.                                         JJJ1129
*         - -SORT- NOW RETURNS THE ORDERED RECORDS BY TRANSFERING TO     JJJ1129
*           MIPGEN LABEL -GETREC- WITH A RECORD FWA IN A2.  AT -GETREC-  JJJ1129
*           SET UP THE A2 ADDRESS AS A PARAMETER AND TRANSFER TO         JJJ1129
*           -MGGT$MP- TO WRITE LEVEL 2 AND 3 OF THE INDEX FILE.  CONTROL JJJ1129
*           RETURNS TO MIPGEN, THEN BACK TO -SORT-, AND THE LOOP         JJJ1129
*           CONTINUES UNTIL -SORT- HAS RETURNED ALL THE RECORDS.         JJJ1129
*         - -SORT- THEN TRANSFERS CONTROL TO MIPGEN LABEL -S.END-.       JJJ1129
*           CLOSE THE DATA FILE AND WRITE -MIPGEN COMPLETE- TO THE       JJJ1129
*           USER,S DAYFILE.                                              JJJ1129
*                                                                        JJJ1129
*#                                                                       JJJ1129
          TITLE  MAIN LOOP                                               JJJ1129
 MIPGEN   BSS    0                                                       MIPGEN 
          SA2    64B         PARAMETER COUNT FROM JOB COMMUNICATION AREA GBK0214
          SB1    1                                                       MIPGEN 
          SB2    X2                                                      GBK0218
          SA1    B1+B1       NAME OF FILE TO IXGEN                       MIPGEN 
          EQ     B2,B0,EOP   IF NO PARAMETERS                            GBK0214
          MX0    42                                                      MIPGEN 
          BX6    X0*X1                                                   MIPGEN 
          MX2    59          COMPLIMENT OF FET BUSY BIT                  GBK0214
          ZR     X6,NUL1     IF FIRST PARAMETER NULL.                    GBK0214
          BX7    -X2+X6      OPERATION COMPLETE INITIAL STATUS           GBK0214
          SA7    SAMFILE     AAM LFN                                     GBK0214
          EQ     B2,B1,EOP   IF ONE PARAMETER                            GBK0214
 NUL1     BSS    0                                                       GBK0214
          SA1    A1+B1       SECOND PARAMETER                            GBK0214
          BX6    X0*X1                                                   GBK0214
          ZR     X6,NUL2     IF NULL                                     GBK0214
          BX7    -X2+X6      OPERATION COMPLETE INITIAL STATUS           GBK0214
          SB3    B1+B1                                                   GBK0214
          SA7    INPUT       INPUT LFN                                   GBK0214
          EQ     B2,B3,EOP   IF NO MORE PARAMETERS                       GBK0214
 NUL2     BSS    0                                                       GBK0214
          SA1    A1+B1       THIRD PARAMETER                             GBK0214
          BX6    X0*X1                                                   GBK0214
          ZR     X6,EOP      IF NULL                                     GBK0214
          BX7    -X2+X6      OPERATION COMPLETE INITIAL STATUS           GBK0214
          SA7    OUTPUT      OUTPUT LFN                                  GBK0214
 EOP      BSS    0                                                       GBK0214
          SA0    SAMFILE                                                 CIM0415
          SET.RM MIPGN,1                                                 CIM0415
          SA1    MGKD+#PLAO#                                             JJJ0717
          SB2    X1                                                      MIPGEN 
          GT     B2,B0,OKLD  IF STATIC LOADED                            MIPGEN 
          SA1    GPNM        GROUP                                       MIPGEN 
          SA2    CPNM        CAPSULE                                     MIPGEN 
          SX3    LIBS        LIBRARY                                     MIPGEN 
          SX4    PLCS        PASSLOC                                     MIPGEN 
          RJ     =XFDL.LDC   LOAD MIPGEN CAPSULE                         MIPGEN 
          ZR     X6,OKLD     FDL SUCCESSFUL                              MIPGEN 
          SB2    X6-6                                                    MIPGEN 
          NZ     B2,NOCAPS   IF NOT LOADED                               MIPGEN 
 OKLD     BSS    0                                                       MIPGEN 
          OPENM  INPUT,INPUT,N                                           MIPGEN 
          OPENM  OUTPUT,OUTPUT,N                                         GBK0214
          OPENM  SAMFILE                                                 MIPGEN 
          REWINDM SAMFILE    REWIND TO FORCE UNLOAD OF OPEN AND KEYDEF   AM2A089
          DATE   CREC 
          CLOCK  CREC+1 
          PUT    OUTPUT,HEADER,0
          EQ     GETDEF                                                  MIPGEN 
          SPACE  1                                                       MIPGEN 
 IXGB     BSS    0                                                       MIPGEN 
          CLOSEM INPUT,N                                                 GBK0214
          CLOSEM OUTPUT,N                                                GBK0214
          SB1    1                                                       MIPGEN 
          SA0    SAMFILE                                                 MIPGEN 
          F.RM   FNF,2       CHECK FOR OUTSTANDING FATAL ERROR ON FILE
          CRMEP  ES=115B,FNF=1,IFOP=(NG X2) 
          F.RM   MIPFS,3     FETCH MIP FSTT ADDR                         CIM0401
          RF.AA  X3,FSKDUNC                                              MIPGEN 
          NZ     X1,KSRT     IF ANY KF=UNIGUE                            MIPGEN 
          RF.AA  X3,FSKDISC                                              MIPGEN 
          NZ     X1,KSRT     IF ANY KF=I-S                               MIPGEN 
          RF.AA  X3,FSKDFIC                                              MIPGEN 
          ZR     X1,DEIX     IF NO KF=FIFO (ALL DELETED)                 MIPGEN 
 KSRT     BSS    0                                                       MIPGEN 
          RF.AA  X3,FSMXALT,2      MAXIMUM ALTERNATE KEY LENGTH          MIPGEN 
          RF.AA  X3,FSPKL,1  PRIMARY KEY LENGTH                          MIPGEN 
          SX4    9                                                       JJJ0311
          IX2    X2+X4       KEYLENGTH + 9                               JJJ0311
          SA4    TENTHC                                                  JJJ0311
          IX7    X2*X4                                                   JJJ0311
          AX7    19          (KEYLENGTH+9) / 10                          JJJ0311
          SX6    10                                                      JJJ0311
          IX4    X7*X6       X4 = LENGTH IN CHAR OF ALT KEY AREA         JJJ0311
          IX1    X1+X6       X1 = KEYDEF + PRIM KEY LENGTH IN CHAR       JJJ0311
          IX6    X4+X1       X6 = LENGTH OF RECORD TO SORT               JJJ0311
          SA7    ALTKEYW                                                 JJJ0311
SORT45    IFEQ   SORT45,4 
          SA6    MRL.+1      MAX RECLG                                   MIPGEN 
          SA6    KEY.+3            SORT KEY SIZE = SORT RL               MIPGEN 
SORT45    ELSE
          SA6    MRL         MAX RECLG
          SA6    KEYL        SORT KEY SIZE
SORT45    ENDIF 
          F.RM   FIAT,2                                                  CIM0418
          RF.AA  X2,FAPKY2A        GET START OF ALT KEY AREA             JJJ0311
          SA3    ALTKEYW                                                 JJJ0311
          IX6    X3+X1                                                   JJJ0311
          SF.AA  X2,FAPKY3A,X6,,6  SET FAPKYA AS CLOSE TO KY2A AS POSIBL JJJ0311
SORT45    IFEQ   SORT45,4 
          SORT   MAXCM=0                                                 MIPGEN 
          OPTIONS COMPARE 
MRL.      OWNCODE (MRL,1),(1,PUTREC),(3,GETREC),(4,S.END)                MIPGEN 
KEY.      KEY    1,1,1,0,LOGICAL,0,A                                     MIPGEN 
          ENDRUN
SORT45    ELSE
          SA1    PARAM1 
          RJ     =XSMSORT 
          SA1    PARAM2 
          RJ     =XSMOPT
          SA1    PARAM3 
          RJ     =XSMOWN
          SA1    PARAM4 
          RJ     =XSMKEY
          RJ     =XSMEND
          ENDRUN
* 
PARAM1    VFD    60/MRL 
          DATA   0
MRL       DATA   0
PARAM2    VFD    60/*+2 
          DATA   0
          DATA   10HCOMPARE 
PARAM3    VFD    60/P31 
          VFD    60/PUTREC
          VFD    60/P33 
          VFD    60/GETREC
          VFD    60/P34 
          VFD    60/S.END 
          DATA   0
P31       DATA   1
P33       DATA   3
P34       DATA   4
PARAM4    VFD    60/*+6 
          VFD    60/*+6 
          VFD    60/*+6 
          VFD    60/*+6 
          VFD    60/*+6 
          DATA   0
          DATA   1
          DATA   1
KEYL      DATA   0
          DATA   0
          DATA   10HLOGICAL 
SORT45    ENDIF 
*                                                                        MIPGEN 
PUTREC    DATA   0           (SORT EXIT1) GIVE UNSORTED REC TO SORT      MIPGEN 
          PASSRJ MGPT        GO BUILD SORT REC FROM DATA REC AND KEYDEF  MIPGEN 
          SA0    SAMFILE                                                 CIM0418
          F.RM   FIAT,2                                                  CIM0418
          RF.AA  X2,FAPKY2A  FWA OF RECORD TO SORT                       CIM0302
SORT45    IFEQ   SORT45,4 
          SA2    X1-1        FWA OF RECORD TO SORT (KD/AV/PV)            CIM0303
          SA3    MRL.+1      SORT RECORD LENGTH                          MIPGEN 
          BX0    X3                                                      MIPGEN 
          LX0    30                                                      MIPGEN 
          EQ     PUTREC                                                  MIPGEN 
SORT45    ELSE
          SX6    X1-1        FWA OF RECORD TO SORT (KD/AV/PV) 
          SA6    PARAM5+1 
          SA1    PARAM5 
          RJ     =XSMRTN
* 
PARAM5    VFD    60/*+3      POINTER TO 0 
          VFD    60/0        FWA OF RECORD TO SORT
          VFD    60/MRL 
          VFD    60/0 
* 
SORT45    ENDIF 
*                ON EXIT:                                                MIPGEN 
*                                  A2= FWA OF SORT REC.                  MIPGEN 
*                                  X0= RECORD LENGTH (VFD 30/C,30/W)     MIPGEN 
*                                                                        MIPGEN 
SORT45    IFEQ   SORT45,4 
SAM$END   SA1    PUTREC            TELL SORT- NO MORE RECORDS            MIPGEN 
          LX1    30                                                      MIPGEN 
          SB7    X1+3                                                    MIPGEN 
          JP     B7                                                      MIPGEN 
SORT45    ELSE
SAM$END   SA1    PARAM6 
          RJ     =XSMRTN
* 
PARAM6    VFD    60/P33 
          VFD    60/0 
SORT45    ENDIF 
*                                                                        MIPGEN 
GETREC    DATA   0           (SORT EXIT3) GET SORTED REC FROM SORT       MIPGEN 
*                            ON ENTRY:                                   MIPGEN 
*                                  A2= FWA OF SORT REC.                  MIPGEN 
*                                  X0= RECORD LENGTH (VFD 30/C,30/W)     MIPGEN 
SORT45    IFEQ   SORT45,4 
          SX6    A2          FWA OF RECORD                               MIPGEN 
SORT45    ELSE
          SX6    X1          FWA OF RECORD
SORT45    ENDIF 
          SA6    GETRA+1                                                 MIPGEN 
          SA1    GETRA                                                   MIPGEN 
          PASSRJ MGGT        GO WRITE LEVEL 2 AND 3 OF INDEX FILE        MIPGEN 
SORT45    IFEQ   SORT45,4 
          SA1    GETREC                                                  MIPGEN 
          LX1    30                                                      MIPGEN 
          SB7    X1                                                      MIPGEN 
          JP     B7+1              DELETE REC (NO OUTPUT SORT FILE)      MIPGEN 
SORT45    ELSE
          SA1    PARAM7 
          RJ     =XSMRTN
* 
PARAM7    VFD    60/P31 
          VFD    60/0 
SORT45    ENDIF 
*                                                                        MIPGEN 
GETRA     VFD    60/*+1            APLIST FOR MGETREC                    MIPGEN 
          VFD    60/0              ADDRESS OF RECORD                     MIPGEN 
*                                                                        MIPGEN 
DEIX      SX6    B0                                                      MIPGEN 
          F.RM   FSTT,3                                                  CIM0418
          SF.AA  X3,FSMIPWO,0 CLEAR MIPWORD IN FSTT                      MIPGEN 
SORT45    IFEQ   SORT45,4 
          RJ     S.END
          EQ     RUNEND 
* 
SORT45    ELSE
          EQ     S.END+1                                                 MIPGEN 
SORT45    ENDIF 
S.END     DATA   0                 (SORT EXIT4)                          MIPGEN 
          SX1    SAMFILE                                                 MIPGEN 
          STORE  X1,FWI=YES  ENSURE FSTT WITH MIPWORD WRITTEN OUT        MIPGEN 
          CLOSEM X1,,,"FO"                                               MIPGEN 
          MESSAGE ENDMES,,RECALL                                         MIPGEN 
SORT45    IFEQ   SORT45,4 
          EQ     S.END
* 
SORT45    ENDIF 
RUNEND    ENDRUN                                                         MIPGEN 
 ENDMES   DIS    0,*MIPGEN COMPLETE*                                     MIPGEN 
*                                                                        AFB1109
          ENTRY  FERR$MG                                                 AFB1109
FERR$MG   MESSAGE DATERR,,RECALL                                         AFB1109
          SX6    B0                                                      AFB1109
          SA0    SAMFILE                                                 AFB1109
          F.RM   FSTT,3                                                  AFB1109
          SF.AA  X3,FSMIPWO,0  CLEAR MIPWORD IN FSTT                     AFB1109
ABT       ABORT 
*                                                                        AFB1109
DATERR    DIS    0,*FATAL ERROR ON DATA FILE*                            AFB1109
*                                                                        MIPGEN 
BADKD     MESSAGE CREC,,RECALL                                           MIPGEN 
          MESSAGE BKDMES,,RECALL                                         MIPGEN 
          SA2    64B
          SX2    X2-4        ARE THERE 4 PARAMETERS 
          NG     X2,RUNEND   NO, ENDRUN 
          SA1    5           IS 4TH PARAM  ABT
          MX0    42 
          BX1    X0*X1
          SA2    =3LABT 
          IX6    X1-X2
          ZR     X6,ABT      YES,ABORT
          EQ     RUNEND                                                  MIPGEN 
BKDMES    DIS    0,*BAD RMKDEF CARD*                                     MIPGEN 
*                                                                        MIPGEN 
 KDCOUNT  DATA   0           RMKDEF BUFFER INDEX                         MIPGEN 
 RMKAP    VFD    42/0,18/SAMFILE                                         MIPGEN 
          VFD    42/0,18/GDRKW                                           MIPGEN 
          VFD    42/0,18/GDRKP                                           MIPGEN 
          VFD    42/0,18/GDKL                                            MIPGEN 
          VFD    42/0,18/GDKI                                            MIPGEN 
          VFD    42/0,18/GDKF                                            MIPGEN 
          VFD    42/0,18/GDKS                                            MIPGEN 
          VFD    42/0,18/GDKG                                            MIPGEN 
          VFD    42/0,18/GDKC                                            MIPGEN 
          VFD    42/0,18/GDNL                                            MIPGEN 
          VFD    42/0,18/GDIE                                            MIPGEN 
          VFD    42/0,18/GDCH                                            MIPGEN 
GDZAP     DATA   0                                                       MIPGEN 
GDLFN     DATA   0                                                       MIPGEN 
GDRKW     DATA   0                                                       MIPGEN 
GDRKP     DATA   0                                                       MIPGEN 
GDKL      DATA   0                                                       MIPGEN 
GDKI      DATA   0                                                       MIPGEN 
GDKF      DATA   0                                                       MIPGEN 
GDKS      DATA   0                                                       MIPGEN 
GDKG      DATA   0                                                       MIPGEN 
GDKC      DATA   0                                                       MIPGEN 
 GDNL     DATA   0                                                       MIPGEN 
 GDIE     DATA   0                                                       MIPGEN 
 GDCH     BSSZ   3                                                       MIPGEN 
 WORD     DATA   0                                                       GBK0104
*                                                                        MIPGEN 
          TITLE  CRACK AND PUT KEYDEF                                    JJJ1129
 PTDF     BSS    0                                                       MIPGEN 
          SA1    RMKAP                                                   GBK0127
          RJ     =XRMKDEF    WRITE LEVEL 1 INDEX FILE                    MIPGEN 
          SA1    =XRM$KDWS   COMPRESSED RMKDEF (WORD 1)                  MIPGEN 
          SB2    19          IF KL=0, THEN SCC DEF                       CIM0602
          MX3    8                                                       CIM0602
        LX2      X1,B2                                                   CIM0602
          BX6    X2*X3                                                   CIM0602
          ZR     X6,GETDEF                                               CIM0602
          SA2    KDCOUNT     RMKDEF BUFFER INDEX                         MIPGEN 
          SA3    MGKD+#PLAO#                                             JJJ0717
          BX6    X1                                                      MIPGEN 
          SB2    X2                                                      MIPGEN 
          SA6    X3+B2       STORE WORD 1 OF RMKDEF INTO BUFFER          MIPGEN 
          SX7    X2+2        INCREMENT BUFFER INDEX                      MIPGEN 
          SA7    A2          SAVE  BUFFER INDEX                          MIPGEN 
          SA2    A1+B1       WORD 2 OF RMKDEF                            MIPGEN 
          BX7    X2                                                      MIPGEN 
          SA7    A6+B1       STORE RMKDEF WORD 2 INTO RMKDEF BUFFER      GBK0127
 GETDEF   BSS    0                                                       MIPGEN 
          GET    INPUT                                                   MIPGEN 
          FETCH  INPUT,FP,X2                                             MIPGEN 
          SX1    X2-#EOR#                                                MIPGEN 
          NZ     X1,IXGB     IF END OF INPUT                             MIPGEN 
          PUT    OUTPUT,DISP,0
*                                                                        GBK0104
****                         ** CRACK RMKDEF CARD INTO FTN APLIST ***    GBK0104
*                                                                        GBK0104
          SB6    GDZAP+16B                                               GBK0104
          SB7    GDZAP                                                   GBK0104
*                            CLEAR PARAMETERS                            GBK0104
 )AA      BSS    0B                                                      GBK0104
          MX7    0B                                                      GBK0104
          SA7    B7                                                      GBK0104
          SB7    B7+1B                                                   GBK0104
          GE     B6,B7,)AA                                               GBK0104
*                            INITIALIZE FOR RMKDEF SCAN.                 GBK0104
          SX7    1B                                                      GBK0104
          MX1    0B                                                      GBK0104
          SA7    WORD                                                    GBK0104
          BX0    X1                                                      GBK0104
          SB1    74B                                                     GBK0104
          SB3    1B                                                      GBK0104
          SB4    GDZAP-1B                                                GBK0104
          SB5    1B                                                      GBK0104
 )AB      BSS    0B                                                      GBK0104
          SA5    WORD                                                    GBK0104
          SB7    6B                                                      GBK0104
          SA2    X5+CREC-1B                                              GBK0104
*                            EXTRACT CHARACTER, CHECK ALPHA, NUM, SPEC.  GBK0104
 )AC      BSS    0B                                                      GBK0104
          SX6    77B                                                     GBK0104
          LX5    B7,X2                                                   GBK0104
          BX7    X6*X5                                                   GBK0104
          SX4    44B                                                     GBK0104
          IX6    X4-X7                                                   GAG1103
          MI     X6,.11      MUST BE TERMINATOR OR ERROR                 GAG1103
          SX6    B5-15B                                                  GAG1103
          PL     X6,.3       TREAT DIGITS AS ALPHA IN GDCH               GAG1103
          SX6    32B                                                     GBK0104
          IX5    X6-X7                                                   GBK0104
          MI     X5,.7                                                   GBK0104
*                            PROCESS ALPHA CHARACTER.  IF IN CHARLIT     GBK0104
*                            STRING ALLOW MOR THAN 10 CHARS.  IN ARG.    GBK0104
 .3       BSS    0B                                                      GBK0104
          SX6    6B                                                      GBK0104
          SX5    B1                                                      GBK0104
          IX0    X6+X0                                                   GBK0104
          IX4    X5-X0                                                   GAG1103
          PL     X4,.6                                                   GAG1103
          SX5    B5                                                      GBK0104
          SX4    15B                                                     GBK0104
          IX3    X5-X4                                                   GBK0104
          NZ     X3,BADKD                                                GBK0104
          SX5    B3                                                      GBK0104
          BX0    X6                                                      GBK0104
          IX1    X5+X1                                                   GBK0104
*                            ADD CHARACTER TO STRING PARAMETER.          GBK0104
 .6       BSS    0B                                                      GBK0104
          SX6    B5                                                      GBK0104
          SX5    B1                                                      GBK0104
          IX4    X1+X6                                                   GBK0104
          SA3    X4+B4                                                   GBK0104
          IX6    X5-X0                                                   GBK0104
          SB2    X6                                                      GBK0104
          LX5    B2,X7                                                   GBK0104
          BX6    X3+X5                                                   GBK0104
          SA6    X4+B4                                                   GBK0104
          EQ     .13                                                     GBK0104
*                            DECODE DECIMAL INTEGER PARAMETER IF NOT     GBK0104
*                            FILE NAME OR CHARLIT.                       GBK0104
 .7       BSS    0B                                                      GBK0104
          SX6    2B                                                      GBK0104
          SX5    B5                                                      GBK0104
          IX4    X5-X6                                                   GBK0104
          ZR     X4,.10                                                  GBK0104
          SX6    17B                                                     GBK0104
          IX4    X5-X6                                                   GBK0104
          ZR     X4,.3                                                   GBK0104
          SA5    B5+B4                                                   GBK0104
          SX6    12B                                                     GBK0104
          DX4    X6*X5                                                   GBK0104
          SX3    33B                                                     GBK0104
          IX6    X7-X3                                                   GBK0104
          IX6    X6+X4                                                   GBK0104
          SA6    B5+B4                                                   GBK0104
          EQ     .13                                                     GBK0104
*                            DIAGNOSE FILE NAME STARTING WITH DIGIT.     GBK0104
 .10      BSS    0B                                                      GBK0104
          ZR     X0,BADKD                                                GBK0104
          EQ     .3                                                      GBK0104
*                            DETECT PARAMETER AND CARD TERMINATORS.      GBK0104
 .11      BSS    0B                                                      GBK0104
          SX6    52B                                                     GBK0104
          IX5    X7-X6                                                   GBK0104
          ZR     X5,GDX                                                  GBK0104
          SX6    57B                                                     GBK0104
          IX5    X7-X6                                                   GBK0104
          ZR     X5,GDX                                                  GBK0104
          SX6    56B                                                     GBK0104
          IX5    X7-X6                                                   GBK0104
          ZR     X5,.12                                                  GBK0104
          SX6    51B                                                     GBK0104
          IX5    X7-X6                                                   GBK0104
          NZ     X5,BADKD                                                GBK0104
          SX6    B3                                                      GBK0104
          SX5    B5                                                      GBK0104
          IX4    X5-X6                                                   GBK0104
          NZ     X4,BADKD                                                GBK0104
*                            INITIALIZE FOR NEXT PARAMETER, DETECT TOO   GBK0104
*                            MANY PARAMETERS.                            GBK0104
 .12      BSS    0B                                                      GBK0104
          SB5    B3+B5                                                   GBK0104
          SX6    17B                                                     GBK0104
          MX0    0B                                                      GBK0104
          SX5    B5                                                      GBK0104
          IX4    X6-X5                                                   GBK0104
          MI     X4,BADKD                                                GBK0104
*                            INCREMENT WORD BYTE POINTER.                GBK0104
 .13      BSS    0B                                                      GBK0104
          SB7    B7+6B                                                   GBK0104
          GE     B1,B7,)AC                                               GBK0104
*                            INCREMENT CARD WORD POINTER.                GBK0104
          SA5    WORD                                                    GBK0104
          SX6    X5-CREC+8-1                                             GBK0127
          SX7    X5+B3                                                   GBK0104
          SA7    A5                                                      GBK0104
          MI     X6,)AB                                                  GBK0104
*                                                                        MIPGEN 
GDX       SA1    GDZAP                                                   MIPGEN 
          SA2    =6LRMKDEF                                               MIPGEN 
          SB1    1                                                       GBK0127
          IX6    X1-X2                                                   MIPGEN 
          SA1    A1+B1                                                   GBK0127
          NZ     X6,BADKD          IF NOT RMKDEF CARD                    MIPGEN 
          SA2    SAMFILE                                                 MIPGEN 
          MX6    42                                                      MIPGEN 
          BX2    X6*X2                                                   MIPGEN 
          IX6    X1-X2                                                   MIPGEN 
          NZ     X6,BADKD          NO LFN ON MIPGEN RMKDEF               MIPGEN 
          EQ     PTDF                                                    MIPGEN 
          SPACE  1                                                       MIPGEN 
 NOCAPS   BSS    0                                                       MIPGEN 
          MESSAGE NOGO,,RECALL                                           MIPGEN 
          ABORT                                                          MIPGEN 
 NOGO     DIS    ,* UNABLE TO LOAD CAPSULE*                              MIPGEN 
          SPACE  1                                                       MIPGEN 
          END    MIPGEN                                                  MIPGEN 
