*DECK,FLSTATC                                                            FLBLOCK
          IDENT MESSAGE                                                  CIM0720
          ENTRY MESSAGE                                                  CIM0720
 MESSAGE  EQ     *+1S17                                                  CIM0720
          MESSAGE X1,,RECALL                                             CIM0720
          ENDRUN MESSAGE                                                 CIM0720
          END                                                            CIM0720
          IDENT  CFG
          B1=1
          TITLE  CFG - CONVERT FLOATING POINT NUMBER TO G (DISPLAY) FORM
,AT.
          COMMENT CONVERT FLOATING POINT NUMBER TO G (DISPLAY) FORMAT.
 CFG      SPACE  4,8
***       CFG  -  CONVERT FLOATING POINT NUMBER TO G (DISPLAY) FORMAT.
* 
*         R. H. GOODELL.     77/01/24.
* 
*         CFG CONVERTS A BINARY FLOATING POINT NUMBER TO A DISPLAY
*         FORMAT SIMILAR TO A *G20.12* SPECIFICATION IN FORTRAN.
* 
*         PROC  CFG  (I, E, L, A).
* 
*         ITEM  I  R.        ITEM VALUE TO BE CONVERTED.
*         ITEM  E  I.        EXPONENT LETTER INDICATOR - 1 = E, 2 = D.
*         ITEM  L  I.        LENGTH (IN CHARACTERS) OF RESULT.
*         ITEM  A  C (20).   CONVERSION RESULT, LEFT JUSTIFIED. 
 DATA     SPACE  4,8
*         LOCAL DATA. 
  
  
 AB       BSS    2           ASSEMBLY BUFFER FOR CONVERSION 
 EV       BSS    1           EXPONENT VALUE 
 PA       BSS    1           PARAMETER LIST ADDRESS 
 SN       BSS    1           SIGN CHARACTER 
  
 D        EQU    13          NUMBER OF DIGITS IN COEFFICIENT
 CFG      SPACE  4,8
*         CFG  -  CONTROL ROUTINE.
  
  
 CFG      SUBR   =           ENTRY/EXIT 
          SB1    1           (B1) = CONSTANT 1
          SA2    X1          VALUE OF I 
          SX6    A1          SAVE PARAMETER LIST ADDRESS
          NX7    X2          MAKE SURE (I) IS NORMALISED
          SA6    PA 
          NZ,X7  CFG1        IF (I) NOT ZERO
          SA7    EV 
          SB2    B1 
          MX1    0           HANDLE (I) = 0   -   PRINT 0.0 
          SB3    3
          SA7    SN 
          EQ     CFG3 
 CFG1     AX2    59 
          BX1    X7-X2       ABS (I)
          SX3    1R--1R0
          BX7    X2*X3       SN = 0 IF +, OR 1R--1R0 IF - 
          SA7    SN 
          RJ     SCALE       REDUCE (I) TO COEFFICIENT AND EXPONENT 
          SB7    X7-D+1 
          SB3    D+1         (B3) = TOTAL DIGITS INCLUDING DEC POINT
          MI,X7  CFG2        IF EXPONENT < 0 OR > FIELD WIDTH 
          PL,B7  CFG2        THEN GO PROCESS AS -E- FORMAT
          SX6    B0 
          SA6    EV          PROCESS AS -F- FORMAT, NO EXPONENT 
          SB2    X7+B1       (B2) = NUMBER OF DIGITS BEFORE DEC POINT 
          RJ     ROUND       ROUND COEFFICIENT TO D DIGITS
          SB2    B2+X7       ADJUST DIGIT COUNT IF CARRY OVERFLOW 
          SB3    B3+X7
          EQ     CFG3 
 CFG2     SB2    X7          SAVE EXPONENT FOR -E- FORMAT 
          RJ     ROUND       ROUND COEFFICIENT TO D DIGITS
          SX7    B2+X7       ADJUST EXPONENT IF CARRY OVERFLOW
          SB2    B1          ONE DIGIT BEFORE DECIMAL POINT 
          SA7    EV          SAVE EXPONENT VALUE
 CFG3     SA2    SN          ALL PATHS REJOIN HERE
          SA5    CFGZ        (X5) = DISPLAY ZEROS 
          SB6    B0          (B6) = ASSEMBLY WORD INDEX 
          SB7    60-6        (B7) = CHARACTER POSITION
          LX2    -6 
          IX6    X5+X2       (X6) = ASSEMBLY
          ZR,X2  CFG4        IF NO SIGN 
          SB7    B7-6        POSITION AFTER SIGN CHARACTER
 CFG4     RJ     FCD         FORMAT COEFFICIENT DIGITS
          RJ     FEX         FORMAT EXPONENT IF ANY 
          SA6    AB+B6       STORE ASSEMBLY WORD
          SX2    B7-60+6
          SX3    6           CHARACTERS IN LAST WORD = (54-B7)/6
          IX4    X2/X3
          SA1    PA          PARAMETER LIST ADDRESS 
          SX2    B6 
          SX6    10          CHARACTERS IN FIRST WORD(S) = 10*B6
          IX7    X2*X6
          SA2    X1+2        LOC OF L 
          SA1    A2+B1       LOC OF A 
          IX6    X7-X4       TOTAL CHARACTER COUNT
          SA3    AB 
          BX4    X5 
          ZR,B6  CFG5        IF ONLY ONE WORD 
          SA4    A3+B1
 CFG5     SA6    X2          STORE CONVERSION LENGTH INTO L 
          BX7    X3 
          LX6    X4          MOVE ASSEMBLY BUFFER TO A
          SA7    X1 
          SA6    X1+B1
          JP     EXIT.       RETURN 
  
 CFGZ     CON    10H0000000000
 CFG      SPACE  4,8
*         CONSTANT TABLES.
  
  
 CFGA     CON    289
          CON    1.0E+289 
          CON    212
          CON    1.0E+212 
          CON    135
          CON    1.0E+135 
          CON    58 
          CON    1.0E+58
          CON    -18
          CON    1.0E-18
          CON    -96
          CON    1.0E-96
          CON    -173 
          CON    1.0E-173 
          CON    -250 
          CON    1.0E-250 
          CON    0
          CON    3.41757925747345E-227
  
 CFGM     CON    1.0E0       MINUS POWERS OF TEN, ROUNDED  DOWN 
          CON    1.0E-1-1 
          CON    1.0E-2-1 
          CON    1.0E-3-1 
          CON    1.0E-4 
          CON    1.0E-5 
          CON    1.0E-6 
          CON    1.0E-7 
          CON    1.0E-8-1 
          CON    1.0E-9-1 
          CON    1.0E-10-1
          CON    1.0E-11-1
          CON    1.0E-12-1
          CON    1.0E-13
          CON    1.0E-14-1
          CON    1.0E-15-1
          CON    1.0E-16-1
          CON    1.0E-17-1
          CON    1.0E-18
          CON    1.0E-19
          CON    1.0E-20
  
 CFGP     CON    1.0E0       PLUS POWERS OF TEN 
          CON    1.0E1
          CON    1.0E2
          CON    1.0E3
          CON    1.0E4
          CON    1.0E5
          CON    1.0E6
          CON    1.0E7
          CON    1.0E8
          CON    1.0E9
          CON    1.0E10 
          CON    1.0E11 
          CON    1.0E12 
          CON    1.0E13 
          CON    1.0E14 
          CON    1.0E15 
          CON    1.0E16 
          CON    1.0E17 
          CON    1.0E18 
          CON    1.0E19 
          CON    1.0E20 
          CON    1.0E21 
 FCD      SPACE  4,8
**        FCD  -  FORMAT COEFFICIENT DIGITS.
* 
*         ENTRY  (X1) = COEFFICIENT, FIXED POINT WITH 54-BIT FRACTION.
*                (B2) = NUMBER OF DIGITS TO PRECEDE DECIMAL POINT.
*                (B3) = TOTAL NUMBER OF DIGITS INCLUDING DECIMAL POINT. 
*                (X5) = DISPLAY ZEROS.
*                (X6) = CURRENT WORD OF ASSEMBLY. 
*                (B6) = ASSEMBLY WORD INDEX.
*                (B7) = NEXT CHARACTER POSITION, I.E. 54,48,...,6,0.
* 
*         EXIT   (X6, B6, B7)  UPDATED. 
*                (X5) = SPACES. 
  
  
 FCD      SUBR               ENTRY/EXIT 
          MX7    6
          SB3    B3-B2
 FCD1     BX2    -X7*X1      FRACTION 
          IX3    X2+X2       2* 
          LX2    3           8* 
          BX4    X7*X1       DIGIT
          ZR,B2  FCD2        IF ALL DIGITS DONE 
          LX4    B7          POSITION DIGIT 
          IX1    X2+X3       10*
          SB7    B7-6 
          SB2    B2-B1       COUNT DIGITS 
          LX4    6
          IX6    X6+X4       ADD TO ASSEMBLY
          PL,B7  FCD1        IF WORD NOT FULL, LOOP 
          SA6    AB+B6       STORE ASSEMBLY WORD
          SB7    60-6 
          SB6    B6+B1       START NEW WORD 
          LX6    X5 
          NZ,B2  FCD1        LOOP 
 FCD2     ZR,B3  FCD3        IF FRACTION DONE 
          SX2    1R.-1R0+1R 
          RJ     ICH         INSERT DECIMAL POINT 
          SB2    B3-B1       NUMBER OF FRACTION DIGITS
          SB3    B0 
          GE,B2,B1  FCD1     IF ANY 
 FCD3     IX3    X6-X5       PROCEED TO REMOVE TRAILING ZEROS 
          SA1    FCDA 
          SA2    A6 
          NZ,X3  FCD4        IF CURRENT WORD NOT ALL ZEROS
          BX6    X2          BACK UP TO PRECEDING WORD
          SB6    B6-B1
 FCD4     SX2    B1 
          BX3    X6-X5       CHANGE ALL ZEROS TO 00 
          IX4    X3-X2       FIND LOWEST BIT SET
          BX2    -X4+X3 
          SB2    60-5 
          BX1    X1*X2       BUILD MASK FOR TRAILING NON-00 CHARACTERS
          LX2    X1,B2
          IX3    X1-X2
          BX1    X1+X3
          MX3    -6 
          BX1    -X1         MASK FOR TRAILING ZEROS
          CX2    X1 
          SB7    X2 
          AX4    X6,B7       GET RIGHTMOST NON-ZERO CHARACTER 
          BX2    -X3*X4 
          SB2    X2-1R. 
          NZ,B2  FCD5        IF NOT DECIMAL POINT 
          SB7    B7-6        KEEP ONE ZERO AFTER DECIMAL POINT
          AX1    6
          PL,B7  FCD5        IF NOT AT WORD BOUNDARY
          BX6    X5 
          MX1    6
          SB7    60-6        SET NEXT WORD
          SB6    B6+B1
          BX1    -X1
 FCD5     SA5    FCDB        (X5) = SPACES
          BX2    -X1*X6 
          SB7    B7-6 
          BX1    X1*X5       REPLACE TRAILING ZEROS WITH SPACES 
          IX6    X2+X1
          SA6    AB+B6
          PL,B7  EXIT.       IF WORD NOT FULL 
          SB7    60-6 
          SB6    B6+B1       START NEW WORD 
          BX6    X5 
          JP     EXIT.       RETURN 
  
 FCDA     CON    40404040404040404040B
 FCDB     CON    10H
 FEX      SPACE  4,8
**        FEX  -  FORMAT EXPONENT, IF ANY.
  
  
 FEX      SUBR               ENTRY/EXIT 
          SA2    PA          PARAMETER LIST ADDRESS 
          SA1    EV          EXPONENT VALUE 
          SA3    X2+B1       LOC OF SECOND ARGUMENT (E) 
          SX2    1RD
          SA4    X3          VALUE OF E 
          SX3    1R+         SET EXPONENT SIGN
          SB2    X4-2 
          PL,X1  FEX1        IF EXPONENT IS POSITIVE
          SX3    1R-
 FEX1     ZR,B2  FEX2        IF *D* WANTED
          SX2    1RE
          ZR,X1  EXIT.       IF *E* AND VALUE IS ZERO 
 FEX2     RJ     ICH         INSERT CHARACTER D OR E
          SX2    X3 
          RJ     ICH         INSERT CHARACTER + OR -
          BX2    X1 
          SX7    100
          AX2    59 
          BX1    X1-X2       ABS (EV) 
          SB2    X1-10
          LX2    X1 
          MI,B2  FEX4        IF ONLY ONE DIGIT
          IX3    X2/X7,B2    GET HUNDREDS DIGIT 
          ZR,X3  FEX3        IF NO HUNDREDS 
          SX7    100
          IX4    X3*X7       REDUCE VALUE 
          IX1    X1-X4
          SX2    X3+1R0 
          RJ     ICH         INSERT CHARACTER 
 FEX3     BX2    X1 
          SX7    10 
          IX3    X2/X7,B2    GET TENS DIGIT 
          SX7    10 
          IX4    X3*X7       REDUCE VALUE 
          IX1    X1-X4
          SX2    X3+1R0 
          RJ     ICH         INSERT CHARACTER 
 FEX4     SX2    X1+1R0      UNITS DIGIT
          RJ     ICH         INSERT CHARACRER 
          JP     EXIT.
 ICH      SPACE  4,8
**        ICH  -  INSERT CHARACTER. 
* 
*         ENTRY  (X2) = THE CHARACTER, IN 1R FORMAT.
*                (X5) = SPACES. 
*                (X6) = CURRENT WORD OF ASSEMBLY. 
*                (B6) = ASSEMBLY WORD INDEX.
*                (B7) = NEXT CHARACTER POSITION.
* 
*         EXIT   (X6, B6, B7)  UPDATED. 
  
  
 ICH      SUBR               ENTRY/EXIT 
          PL,B7  ICH1        IF WORD NOT FULL 
          SA6    AB+B6       STORE ASSEMBLY WORD
          SB6    B6+B1
          SB7    60-6        START NEW WORD 
          LX6    X5 
 ICH1     SX2    X2-1R       INSERT NEW CHARACTER 
          LX2    B7 
          IX6    X6+X2
          SB7    B7-6        ADJUST CHARACTER POSITION
          JP     EXIT.
 ROUND    SPACE  4,8
**        ROUND  -  ROUND COEFFICIENT FOR DECIMAL DIGITS. 
* 
*         ENTRY  (X1) = COEFFICIENT, 1.0 .LE. VALUE .LT. 10.0.
* 
*         EXIT   (X1) = COEFFICIENT AS UNSIGNED BINARY FIXED (6,54).
*                (X7) = 1 IF ROUNDING CAUSED CARRY, ELSE 0. 
  
  
 ROUND    SUBR               ENTRY/EXIT 
          SX2    D           NUMBER OF DIGITS WANTED
          MX3    -4 
          BX4    -X3*X2      D MOD 16 
          AX2    4           D / 16 
          SA3    CFGM+X4     SMALL PART 
          SA4    RNDA+X2     BIG PART 
          FX2    X3*X4
          RX1    X1+X2       ADD ROUNDING VALUE 
          SX3    2S10        FORCE ROUND UP 
          UX1,B7
          SB6    B7+54       MAKE COEFFICIENT FIXED POINT 
          LX2    X1,B6       WITH 54-BIT FRACTION 
          IX1    X2+X3
          UX4,B7 X1          CHECK FOR OVERFLOW 
          SB6    B7+1777B-10S6
          SX7    B0 
          MI,B6  EXIT.       IF < 10.0
          SX1    B1 
          BX7    X1 
          LX1    54          OVERFLOW, RETURN 1.0 
          JP     EXIT.
  
  
 RNDA     CON    5.0+5       ROUNDING FACTORS 
          CON    5.0E-16+5
          CON    5.0E-32+5
 SCALE    SPACE  4,8
**        SCALE  -  REDUCE GIVEN NUMBER TO COEFFICIENT AND EXPONENT.
* 
*         ENTRY  (X1) = THE NUMBER. 
* 
*         EXIT   (X1) = COEFFICIENT.
*                (X7) = EXPONENT. 
* 
*         THE RESULTS ARE SUCH THAT 
* 
*                      1.0  .LE.  (X1)  .LT.  10.0,  AND
*                      (X1) * 10.0 ** (X7)  = ORIGINAL NUMBER.
  
  
 SCALE    SUBR               ENTRY/EXIT 
          UX6,B2 X1 
          SX2    B2+2360B 
          AX2    8           (EXP+2360B)/256 = SUBSCRIPT FOR CFGA 
          SB2    X2-4 
          SA3    CFGP+1      =10.0
          NZ,B2  SCA1        IF NOT  1E-55 TO 1E+18 
          IX4    X1-X3
          SB3    -20         BEGIN EXPONENT 
          MI,X4  SCA3        IF  1E-55 TO 1E+1
 SCA1     LX2    1
          SA3    CFGA+X2     OFFSET FOR EXPONENT
          SA4    A3+B1       10.0**N / 2**N 
          SB3    X3-20       BEGIN EXPONENT 
          NZ,X3  SCA2        IF NOT 1E-324
          SX3    -324 
          SB3    B3+X3       SPECIAL CASE - MACHINE CAN HOLD
          LX3    48          5E-324 BUT NOT 1E-324
          IX1    X1+X3
 SCA2     FX1    X1*X4       REDUCE NUMBER TO 1E-79 TO 1E+1 
          ZR,X1  SCA6 
 SCA3     SA3    CFGM+19     MULTIPLY BY 1E+20 UNTIL NUMBER 
          SA4    CFGP+20     IS AT LEAST 1E-19
          IX2    X1-X3
          SB3    B3+20       TALLY EXPONENT 
          MI,X2  SCA2        IF STILL LESS THAN 1E-19, LOOP 
          SA3    CFGP+0      =1.0 
          IX4    X1-X3
          PL,X4  SCA5        IF NOT LESS THAN 1E0 
          UX2,B2 X1 
          SX3    B2+54B      NUMBER IS NOW 1E-19 TO 1E+1
          BX4    -X3
          LX3    2           COMPUTE APPROXIMATE LOG10
          IX4    X4-X3         =  - ((EXP+54B)*5)/16 - 2
          AX4    4
          SA2    CFGM+X4-1   =1E-N
          IX3    X1-X2
          MI,X3  SCA4        IF CORRECT LOG10 
          SX4    X4-1 
 SCA4     SA2    CFGP+X4     MULTIPLY NUMBER BY 1E+N
          SB3    B3+X4       TALLY EXPONENT 
          FX1    X1*X2
          BX3    X1          CHECK FOR NUMBER EQUAL TO
          AX3    45          0.9999999999999999ENNN 
          SX2    X3-1.0/1S45
          SX4    B1          IF SO, MULTIPLY BY TEN 
          MI,X2  SCA4 
 SCA5     SX7    -B3         (X7) = EXPONENT
          JP     EXIT.
 SCA6     SX7    B0          NUMBER = MACHINE ZERO
          JP     EXIT.
  
  
          END 
          IDENT  XCDD 
          B1=1
          LIST   F,X
          TITLE  XCDD - CONVERT INTEGER TO DECIMAL DISPLAY CODE.
          COMMENT  CONVERT INTEGER TO DECIMAL DISPLAY CODE. 
 XCDD     SPACE  4,8
**        XCDD  -  CONVERT INTEGER TO DECIMAL DISPLAY CODE. 
* 
*         R. H. GOODELL.     76/06/22.
* 
*         SYMPL-CALLABLE ENTRY POINTS FOR INTERFACING TO THE
*         STANDARD COMPASS-CALLABLE ROUTINE.
 XCDD     SPACE  4,8
**        XCDD - CONVERSION RIGHT JUSTIFIED.
* 
*         FUNC XCDD (N) C (10). 
* 
*         ITEM N I.          INTEGER TO BE CONVERTED. 
  
  
 XCDD     SUBR   =           ENTRY/EXIT 
          SB1    1           (B1) = 1 
          SA1    X1+         FETCH N
          RJ     =XCDD       CONVERT
          JP     EXIT.       RETURN, RESULT IN X6 
 XCDDL    SPACE  4,8
**        XCDDL - CONVERSION LEFT JUSTIFIED.
* 
*         PROC XCDDL (N, M, L). 
* 
*         ITEM N I.          INTEGER TO BE CONVERTED. 
*         ITEM M C (10).     CONVERTED RESULT.
*         ITEM L I.          6 * NUMBER OF DIGITS IN (M). 
  
  
 XCDDL    SUBR   =           ENTRY/EXIT 
          SB1    1           (B1) = 1 
          SB7    A1          SAVE (A1)
          SA1    X1          FETCH N
          RJ     =XCDD       CONVERT
          SA1    B7+B1       FETCH M AND L ADDRESSES
          SA2    A1+B1
          BX6    X4          (M) = LEFT JUSTIFIED RESULT
          SX7    B2          (L) = BIT COUNT OF SIGNIFICANT DIGITS
          SA6    X1 
          SA7    X2 
          JP     EXIT.       RETURN 
 CDD      SPACE  4,8
**        CDD  -  COMPASS-CALLABLE ROUTINE. 
  
  
          CTEXT  COMCCDD - CONSTANT TO DECIMAL DISPLAY CODE CONVERSION. 
 CDD      SPACE  4
          IF     -DEF,QUAL$,1 
          QUAL   COMCCDD
          BASE   D
*         COMMENT COPYRIGHT CONTROL DATA SYSTEMS, INC. 1994.
 CDD      SPACE  4
***       CDD - CONSTANT TO DECIMAL DISPLAY CODE CONVERSION.
*         G. R. MANSFIELD.  70/12/18. 
*         ADAPTED FROM SUBROUTINE *CONDEC* IN *COMPASS VER 2.0*.
 CDD      SPACE  4
***              CDD CONVERTS UP TO 10 DIGITS TO DISPLAY CODE WITH
*         LEADING ZERO SUPPRESSION.  CONVERSION CONTAINS SPACE FILL 
*         AND IS RIGHT AND LEFT JUSTIFIED.
* 
*         ENTRY  (X1) = NUMBER TO BE CONVERTED. 
*                (B1) = 1.
* 
*         EXIT   (X6) = DPC CONVERSION RIGHT JUSTIFIED. 
*                (X4) = DPC CONVERSION LEFT JUSTIFIED.
*                (B2) = 6*COUNT OF DIGITS CONVERTED.
* 
*         USES   X - 1, 2, 3, 4, 6, 7.
*                B - 2, 3, 4. 
*                A - 2, 3, 4. 
* 
*         CALLS  NONE.
  
  
 CDD1     DX6    X1*X2       COMPUTE QUOTIENT 
          FX1    X1*X2
          UX7    X1          CHECK QUOTIENT 
          LX4    -6          SHIFT ASSEMBLY 
          SB2    B2+B4
          FX6    X6*X3       EXTRACT REMAINDER DIGIT
          SX6    X6+B3       CONVERT DIGIT
          IX4    X6+X4
          NZ     X7,CDD1     LOOP TO ZERO QUOTIENT
          LX4    -6          LEFT JUSTIFY ASSEMBLY
          LX6    X4,B2       RIGHT JUSTIFY ASSEMBLY 
  
 CDD      PS                 ENTRY/EXIT 
          SA2    CDDA        =.1P48+1 
          SA3    A2+B1       =10.P
          PX1    X1 
          SB2    B0          CLEAR JUSTIFY COUNT
          SA4    A3+B1       =1H
          SB3    1R0-1R      (B3) = CONVERSION CONSTANT 
          SB4    6           (B4) = SHIFT INCREMENT 
          EQ     CDD1 
  
 CDDA     CON    0.1P48+1 
          CON    10.P 
          CON    1H 
          SPACE  4
          BASE   *
 QUAL$    IF     -DEF,QUAL$ 
          QUAL   *
 CDD      EQU    /COMCCDD/CDD 
 QUAL$    ENDIF 
          ENDX
  
  
          ENTRY  CDD
  
  
          END 
          IDENT  KEYTEST
          ENTRY  KEYTEST
***  KEYTEST -- SHOW WHAT SOME RMKDEF STATEMENTS DESCRIBE 
* 
*     A.F.R.BROWN    80/10/28 
* 
*     MIPGEN REQUIRES RMKDEF STATEMENTS TO TELL WHERE IN EACH 
*     RECORD THE ALTERNATE KEY VALUES ARE TO BE FOUND. ESPECIALLY 
*     WHEN THE FILE IS GENERATED BY A COBOL PROGRAM, FIELD DESCRIP- 
*     TIONS IN TERMS OF RKW, RKP, AND KL MAY NOT BE COMPLETELY
*     OBVIOUS. SO THE USER WOULD LIKE TO MAKE SURE THE RMKDEF 
*     STATEMENTS DESCRIBE THE FIELDS HE THINKS THEY DO-- BEFORE 
*     CALLING MIPGEN ITSELF.
* 
*     THIS PROGRAM OFFERS A QUICK-AND-DIRTY CHECK. IT IS CALLED 
*     AS A VARIETY OF FLSTAT. 
* 
*     IF A FLSTAT CONTROL STATEMENT HAS ((RMKDEF)) AS A THIRD 
*     PARAMETER (HITHERTO FLSTAT HAS USED ONLY TWO PARAMETERS), 
*     THE FIRST TWO PARAMETERS KEEP THEIR TRADITIONAL MEANINGS
*     (AAM FILE TO BE DESCRIBED, AND FILE TO RECEIVE THE OUTPUT 
*     LISTING), BUT INSTEAD OF OUTPUTTING A DESCRIPTION OF THE
*     AAM FILE, GLEANED FROM ITS FSTT, FLSTAT JUST NOTES THE FO 
*     OF THE FILE (IS, DA OR AK), CLOSES IT AGAIN, AND CALLS KEYTEST, 
*     PASSING A NOTE OF THE FO. THUS KEYTEST CAN OPEN THE FILE PROPERLY 
*     WITHOUT REQUIRING A FILE STATEMENT FROM THE USER, TO SPECIFY FO.
*     WE DONT WANT THE USER TO GIVE A FILE STATEMENT, BECAUSE HE WOULD
*     PROBABLY BE CONFUSED AND TRY TO SPECIFY THE NAME OF THE MIP FILE
*     HE IS PREPARING TO BUILD. THIS WOULD PROBABLY CAUSE A FATAL OPEN
*     ERROR.
* 
*     KEYTEST READS FROM FILE -INPUT- A RECORD OF RMKDEF STATEMENTS,
*     PRESUMABLY THE SAME ONES THE USER IS CONSIDERING FEEDING TO MIPGEN
*     LATER. IF THERE ARE MORE THAN NINE, KEYTEST IGNORES THE EXTRA 
*     RMKDEFS. IT ALSO IGNORES ALL PARAMETERS EXCEPT RKW, RKP, AND KL.
*     THUS IF REPEATING GROUPS ARE SPECIFIED BY AN RMKDEF, ONLY THE 
*     FIRST OCCURRENCE OF THE SPECIFIED ALTERNATE KEY WILL BE MARKED
*     IN EACH RECORD. 
* 
*     IF YOU WANT THE INPUT TO BE ON SOME FILE OTHER THAN -INPUT-,
*     GIVE THE INPUT FILE NAME AS FOURTH PARAMETER TO FLSTAT. 
* 
*     KEYTEST THEN READS THE FIRST 20 RECORDS OF THE AAM FILE.
*     EACH RECORD IS PRINTED OUT AS A CHARACTER STRING, 100 
*     CHARACTERS PER PRINT LINE. COLONS ARE REPLACED BY BLANKS, 
*     TO AVOID FUNNY LINE-ENDS. IF A RECORD IS OVER 1000 CHARAC-
*     TERS, THE SURPLUS IS IGNORED. WE JUST ASSUME THE ALTERNATE
*     KEY FIELDS ARE UNLIKELY TO BE SO FAR DOWN.
* 
*     UNDER EACH LINE OF PRINT, AN EXTRA LINE IS INSERTED,
*     CONTAINING BLANKS UNDER ALL FIELDS THAT ARE NOT INCLUDED IN 
*     ANY ALTERNATE KEY FIELD, 1-S UNDER THE FIELD SPECIFIED BY THE 
*     FIRST RMKDEF, 2-S UNDER THE FIELD SPECIFIED BY THE SECOND,
*     AND SO ON. IF IT HAPPENS THAT A GROUP OF CHARACTERS IS
*     INCLUDED IN MORE THAN ONE ALTERNATE KEY FIELD, THE LARGEST
*     DIGIT THAT MIGHT BE APPROPRIATE TO EACH CHARACTER POSITION IS 
*     THE ONE THAT WILL APPEAR IN THE OUTPUT. IN OTHER WORDS, THE 
*     STRING OF 1-S IS LAID DOWN FIRST, THEN THE STRING OF 2-S, 
*     WHICH MAY PERHAPS OVERWRITE ONE OR MORE 1-S, THEN THE 3-S,
*     AND SO ON.
* 
*     EXECUTION BEGINS AT KEYTEST, A FEW LINES DOWN.
* 
* 
FAT       FILE   FO=IS,WSA=REC,ERL=1,EFC=3,DFC=3,ORG=NEW
REC       BSSZ   100
INPUT     FILE   RT=Z,WSA=OLINE+1,MRL=80,BT=C 
OUTPUT    FILEC  OBUF,65,(WSA=OLINE,11) 
OBUF      BSSZ   65 
OLINE     DATA   10H
          BSSZ   8
          DATA   20H
* 
*     THE THREE INCOMING PARAMETERS ARE BOOLEANS SET BY THE 
*     CALLER (FLSTAT). THE FIRST IS TRUE (NON-ZERO) IF THE AAM
*     FILE IS IS, THE SECOND IS TRUE IF IT IS DA, THE THIRD IS
*     TRUE IF IT IS AK. WE INSERT THE APPROPRIATE FO IN THE FIT 
*     BEFORE OPENING IT. IF ALL ARE FALSE, THIS IS A MIP FILE,
*     WHICH FLSTAT HAD NO OBJECTION TO DESCRIBING, BUT WHICH IS 
*     INAPPROPRIATE HERE. ABORT WITH THE MESSAGE ((NOT IS DA OR 
*     AK FILE)).
* 
KEYTEST   BSSZ   1
          SA2    A1+1 
          SA3    A2+1 
          SX4    #IS# 
          SA1    X1 
          NZ     X1,KTA 
          SX4    #DA# 
          SA2    X2 
          NZ     X2,KTA 
          SX4    #AK# 
          SA3    X3 
          NZ     X3,KTA 
          MESSAGE NOTYPE,,RECALL
          ABORT 
* 
NOTYPE    DIS    0,*NOT IS DA OR AK FILE* 
* 
KTA       STORE  FAT,FO=X4
* 
*     NOW SET B3 TO HOLD, WHERE WE SHALL STORE TRIPLETS OF RKW, 
*     RKP, AND KL FROM RMKDEF STATEMENTS. GET THE FIRST PARAMETER 
*     FROM THE FLSTAT CALL STATEMENT, THE NAME OF THE AAM FILE, AND 
*     STUFF IT INTO THE FIT AT FAT. IF THE SECOND PARAMETER IS NOT
*     NULL, IT IS THE NAME OF THE OUTPUT FILE, INSTEAD OF 
*     -OUTPUT-, AND WE STUFF IT INTO THE FET AT OUTPUT. 
*     IF THERE IS A FOURTH PARAMETER, USE IT AS THE FILE NAME 
*     IN THE FET AT INPUT.
* 
          SA1    2
          MX0    42 
          BX6    X0*X1
          SA1    FAT
          BX1    -X0*X1 
          BX6    X6+X1
          SA6    A1 
          SA1    52 
          SB2    X1          PARAMETER COUNT
          SB2    B2-1 
          ZR     B2,VAA 
          SA1    3
          BX6    X0*X1
          ZR     X6,KTB 
          SA1    OUTPUT 
          BX1    -X0*X1 
          BX6    X6+X1
          SA6    A1 
KTB       SB2    B2-3 
          NG     B2,VAA 
          SA1    5
          MX0    42 
          BX6    X0*X1
          SA1    INPUT
          BX1    -X0*X1 
          BX6    X6+X1
          SA6    A1 
VAA       OPENM  INPUT,,N 
          SB3    HOLD 
* 
*     NOW READ RMKDEF CARDS FROM FILE INPUT. FOR EACH ONE,
*     VERIFY THAT IT STARTS WITH ((RMKDEF)) AND THE AAM FILE
*     NAME (THIS IS JUST WHAT MIPGEN WOULD START BY DOING.) 
*     THEN MAKE SURE THREE NUMBERS FOLLOW THE FILE NAME, AND STORE
*     THEM IN THE NEXT 3 WORDS IN THE HOLD AREA, USING B3 AS POINTER. 
*     IF THERE IS ANY BADNESS, ABORT WITH THE MESSAGE ((RMKDEF
*     STATEMENT ERROR)). AFTER NINE RMKDEFS, OR END-OF-RECORD ON THE
*     INPUT FILE, WHICHEVER COMES FIRST, PASS ON TO THE NEXT PHASE
*     AT VD.
*     EACH RMKDEF STATEMENT IS COPIED TO THE OUTPUT FILE. 
* 
VA        SX6    B3 
          SA6    HALD 
          GET    INPUT
          SA1    HALD 
          SB3    X1 
          FETCH  INPUT,FP,X3
          SX1    X3-20B 
          NZ     X1,VD
          WRITOUT OUTPUT
          SA1    OLINE+1
          MX0    42 
          BX6    X0*X1
          SA2    =7LRMKDEF, 
          IX2    X2-X6
          ZR     X2,VB
          SA2    =7LRMKDEF( 
          IX2    X2-X6
          NZ     X2,RMKERR
VB        LX1    42 
          SB2    3
          MX0    54 
          SX6    B0 
          SB4    8
VBA       LX1    6
          BX2    -X0*X1 
          SX3    X2-1R, 
          ZR     X3,VBB 
          LX6    6
          BX6    X6+X2
          SB4    B4-1 
          ZR     B4,RMKERR
          SB2    B2-1 
          NZ     B2,VBA 
          SA1    A1+1 
          SB2    10 
          EQ     VBA
* 
HALD      DATA   0
* 
VBB       SB4    B4+2 
          SB2    B2-1 
VBC       LX6    6
          SB4    B4-1 
          NZ     B4,VBC 
          SA2    FAT
          MX0    42 
          BX2    X0*X2
          IX2    X2-X6
          NZ     X2,RMKERR
* 
VC        RJ     GNUM 
          SA6    B3 
          SB3    B3+1 
          SX2    X2-1R, 
          NZ     X2,RMKERR
          RJ     GNUM 
          SX7    X6-10
          PL     X7,RMKERR
          SA6    B3 
          SB3    B3+1 
          SX2    X2-1R, 
          NZ     X2,RMKERR
          RJ     GNUM 
          SA6    B3 
          SB3    B3+1 
          SX6    B3-HOLD-27 
          NG     X6,VA
          EQ     VD 
* 
RMKERR    MESSAGE RMKMES,,RECALL
          ABORT 
* 
RMKMES    DIS    0,*RMKDEF STATEMENT ERROR* 
* 
* 
*     IF THERE WERE NO RMKDEF STATEMENTS AT ALL, ABORT. 
*     IN THE AREA BEGINNING AT GHOST, PREPARE THE LINE
*     THAT WILL BE PRINTED UNDER EACH OF THE FIRST 20 RECORDS 
*     OF THE AAM FILE. FIRST FILL 1000 CHARACTERS WITH BLANKS.
* 
VD        SX6    B3-HOLD
          ZR     X6,RMKERR
          MX6    1
          SA6    B3 
          SB2    99 
          SA1    =10L 
          BX6    X1 
VDA       SA6    GHOST+B2 
          SB2    B2-1 
          PL     B2,VDA 
* 
*     FOR EACH OF THE NUMBER TRIPLETS TAKEN FROM RMKDEF 
*     STATEMENTS, SET B4=RKW, B5=RKP, B6=KL. B6 MIGHT BE
*     0 IN A STATEMENT DEFINING THE SPARSE KEY CONTROL
*     CHARACTER. IF SO, IGNORE IT AND PASS TO THE NEXT RMKDEF.
*     OTHERWISE, FILL THE DIGITS TAKEN FROM WORD -NUMBER- INTO
*     B6 CONSECUTIVE CHARACTERS, BEGINNING AFTER THE B5-TH
*     CHARACTER IN THE WORD AT GHOST+B4.
* 
          SB3    HOLD 
VDB       SA1    B3 
          NG     X1,VE
          SA2    A1+1 
          SA3    A2+1 
          SB3    A3+1 
          SB4    X1+GHOST 
          SB5    X2          RKP
          SB6    X3          KL 
          ZR     B6,VDX 
VDC       SX6    B5+B6
          SA1    MASK+B5
          SX7    X6-11
          PL     X7,VDD 
          SA2    MASK+X6
          BX1    X1-X2
          SB7    B6+B5
          EQ     VDE
* 
VDD       SB7    10 
VDE       SA2    B4 
          BX2    -X1*X2 
          SA3    NUMBER 
          BX3    X1*X3
          BX6    X2+X3
          SA6    B4 
          SB4    B4+1 
          SB6    B6+B5
          SB5    B0 
          SB6    B6-B7
          NZ     B6,VDC 
* 
*     AFTER EACH TRIPLET HAS BEEN PROCESSED, ADVANCE THE DIGITS 
*     IN WORD NUMBER BY 1. WE KNOW IT WONT GO ABOVE 9999999999
*     BECAUSE NOT MORE THAN 9 RMKDEF CARDS WERE READ. 
* 
VDX       SA1    NUMBER 
          SA2    =10LAAAAAAAAAA 
          IX6    X1+X2
          SA6    A1 
          EQ     VDB
* 
*     HAVING PREPARED THE GHOST LINE, OPEN THE AAM FILE, AND
*     READ ITS FIRST 20 RECORDS. AFTER EACH READ, CHECK FOR FP=EOF
*     AND TERMINATE IF SO. OTHERWISE, GET THE RECORD LENGTH,
*     REDUCE TO 1000 CHARACTERS IF ABOVE THAT, REPLACE
*     ALL COLONS (00B) WITH BLANKS, AND OUTPUT IT 100 CHARACTERS
*     PER LINE. AFTER EACH LINE, OUTPUT THE CORRESPONDING LINE
*     FROM THE GHOST AREA, SO THAT ANY ALTERNATE KEY FIELDS 
*     WILL APPEAR TO BE APPROPRIATELY ((UNDERLINED)). 
* 
VE        OPENM  FAT,INPUT
VEA       GETN   FAT
          FETCH  FAT,FP,X3
          SX3    X3-100B
          ZR     X3,VEND
          FETCH  FAT,RL,X3
          SB3    X3 
          SX6    B3-1000
          NG     X6,VEB 
          SB3    1000 
VEB       SB4    B3 
          SA1    REC
VEC       SX7    B0 
          MX0    54 
          SX2    1R 
VECA      BX3    -X0*X1 
          NZ     X3,VECB
          BX7    X7+X2
VECB      LX0    6
          LX2    6
          SX3    X2-1R
          NZ     X3,VECA
          BX7    X7+X1
          SA7    A1 
          SA1    A1+1 
          SB4    B4-10
          NG     B4,VED 
          NZ     B4,VEC 
VED       SB5    REC
VEDA      SB6    100
          GE     B3,B6,VEE
          SB6    B3 
VEE       RJ     PRINT
          SB5    B5-REC+GHOST 
          RJ     PRINT
          SB5    B5+REC-GHOST+10
          SB3    B3-100 
          NG     B3,VF
          NZ     B3,VEDA
VF        SA1    COUNT
          SX6    X1+1 
          SA6    A1 
          SX6    X6-20
          NG     X6,VEA 
VEND      WRITER OUTPUT 
          CLOSEM FAT
          ENDRUN
* 
COUNT     DATA   0
* 
GNUM      DATA   0
          SX6    B0 
          MX0    54 
GNUMA     LX1    6
          BX2    -X0*X1 
          SX3    X2-1R, 
          ZR     X3,GNUMX 
          SX3    X2-1R) 
          ZR     X3,GNUMX 
          SX3    X2-1R. 
          ZR     X3,GNUMX 
          SX3    X2-1R0 
          NG     X3,RMKERR
          SX4    X3-10
          PL     X4,RMKERR
          SX4    10 
          IX6    X6*X4
          IX6    X6+X3
          SB2    B2-1 
          NZ     B2,GNUMA 
          SA1    A1+1 
          SB2    10 
          EQ     GNUMA
* 
GNUMX     SB2    B2-1 
          NZ     B2,GNUM
          SA1    A1+1 
          SB2    10 
          EQ     GNUM 
* 
MASK      BSS    0
XXX       SET    0
          DUP    10,2 
          VFD    XXX/0,*P/-0
XXX       SET    XXX+6
* 
PRINT     DATA   0
          SA1    B5          B5=FROM,B6=LENGTH IN CHARACTERS
          SB7    B6 
          SX7    OLINE+1
PRINTA    SX6    B7-10
          PL     X6,PRINTB
          SA2    MASK+B7
          BX1    -X2*X1 
          SA3    =10L 
          BX3    X2*X3
          BX1    X1+X3
PRINTB    SB7    X6 
          BX6    X1 
          SA6    X7 
          SX7    X7+1 
          SA1    A1+1 
          NG     B7,PRINTC
          NZ     B7,PRINTA
PRINTC    SA1    =10L 
          BX6    X1 
PRINTE    SX1    X7-OLINE-11
          ZR     X1,PRINTD
          SA6    X7 
          SX7    X7+1 
          EQ     PRINTE 
* 
PRINTD    WRITOUT OUTPUT
          EQ     PRINT
* 
HOLD      BSSZ   300
GHOST     BSSZ   100
NUMBER    DATA   10H1111111111
* 
          END 
