*DECK   S$5KEY
          PROC  S$5KEY(NPARMS,ARRY);
#**       S$5KEY -  COLLECT SPECIFICATIONS OF A KEY FIELD              #
#                                                                      #
#     CALLING SEQUENCE-                                                #
#         CALL SM5KEY(F,L,T,AD)                                        #
#           (THIS CALLS THE MACHINE-DEPENDENT ROUTINE *SM5KEY*         #
#            WHICH COUNTS PARAMETERS AND CALLS S$5KEY.)                #
#                                                                      #
#     GIVEN-                                                           #
#         NPARAMS = NUMBER OF PARAMETERS ORIGINALLY SUPPLIED.          #
#         ARRY :                                                       #
#         F = THE FIRST BYTE OR BIT OF THE FIELD.                      #
#         L = THE LAST BYTE OR BIT OF THE FIELD.                       #
#         T = THE KEY TYPE REFERS TO THE FORMAT OF THE DATA IN         #
#             THE FIELD, THE COLLATING SEQUENCE FOR NONUMERIC          #
#             CHARACTERS AND WHETHER F AND L REFER TO BYTES OR BITS.   #
#                     (SEE REFERENCE MANUAL FOR DETAILS)               #
#         AD = SEQUENCING ORDER FOR SORT PROCESSING.                   #
#             "A"  ASCENDING  (DEFAULT)                                #
#             "D"  DESCENDING                                          #
#                                                                      #
#     DOES-                                                            #
#         IF SM5KEY WAS NOT CALLED IN THE PROPER ORDER,                #
#             ISSUE A DIAGNOSTIC, AND                                  #
#             RETURN.                                                  #
#         IF LESS THAN 1 OR MORE THAN 4 ORIGINAL PARAMETERS WERE GIVEN,#
#             ISSUE A DIAGNOSTIC, AND                                  #
#             RETURN.                                                  #
#         IF SEPECIFIED KEYWORDS ARE ILLEGAL,                          #
#             ISSUE A DIAGNOSITIC, AND                                 #
#             ASSUME A RESONABLE DEFAULT.                              #
#         IF THE *TYPE* PARAMETER WAS OMITTED,                         #
#             ASSUME "DISPLAY".                                        #
#         IF THE *ORDER* PARAMETER WAS OMITTED,                        #
#             ASSUME "A".                                              #
  
  
  
          BEGIN 
*CALL NPARMS
          ITEM  F            I;        # FIRST BYTE OR BIT OF THE FIELD#
          ITEM  L            I;        # LAST BYTE OR BIT OF THE FIELD #
          ITEM T             C(10);    # KEY TYPE                      #
          ITEM  AD           C(1);     # SEQUENCING ORDER              #
          ARRAY  ARRY[0:0] S(4);
            BEGIN 
              ITEM  ARRY$F          I(0, 0,60); 
              ITEM  ARRY$L          I(1, 0,60); 
              ITEM  ARRY$T          C(2, 0,60); 
              ITEM  ARRY$AD         C(3, 0, 6); 
            END 
  
  
          XREF
              BEGIN 
              PROC  S$BFILL;            # BLANK FILL A LITERAL         #
              PROC  S$ERROR;           # HANDLE A USER ERROR           #
              FUNC  S$INSEQ  B;        # TRUE IFF CALLED IN ORDER      #
              FUNC  S$NEWGR  I;        # NEW GROUP NUMBER              #
              PROC  S$SVREL;           # SAVE PARAM FROM RELOCATABLE   #
              END 
  
  
*CALL A 
  
*CALL E$
  
*CALL KT$ 
  
*CALL RP$ 
  
*CALL SQ$ 
  
  
          ITEM  BITPOS       I;        # NUM. OF LEFT-MOST BIT IN BYTE #
          ITEM  BYTEPOS      I;        # NUM. OF LEFT-MOST BYTE IN KEY #
          ITEM  COLSEQ       C(7);     # COLLATING SEQUENCE            #
          ITEM  GROUP        I;        # NUMBER OF CURRENT GROUP       #
          ITEM  I            I; 
          ITEM  KEYTYPE      I;        # KEY TYPE FORMAT               #
          ITEM  NBITS        I;        # NUM. OF BITS SPECIF. BY BYTES #
          ITEM  NBYTES       I;        # NUM. OF BYTES IN THE FIELD    #
          ITEM  FOUND  B; 
          ITEM  HOLDI;
  
          DEF  NTYPES  #11#;
          ARRAY [1:11]  S(2); 
              BEGIN 
              ITEM TYPEVAL   C(0,0,10) =
                                       ["BINARY    "
                                       ,"BINARY_BIT"
                                       ,"INTEGER   "
                                       ,"INTEGER_BI"
                                       ,"NUMERIC_FS"
                                       ,"NUMERIC_NS"
                                       ,"NUMERIC_LO"
                                       ,"NUMERIC_LS"
                                       ,"NUMERIC_TO"
                                       ,"NUMERIC_TS"
                                       ,"REAL      "
                                       ]; 
              ITEM TYPEOPT    I(1,56,4) = 
                                       [ KT$T"LOGICAL"    # BINARY     #
                                       , KT$T"LOGICAL"    # BINARYBITS #
                                       , KT$T"INTEGER"    # INTEGER    #
                                       , KT$T"INTEGER"    # INTEGERBITS#
                                       , KT$T"NUMERICFS"
                                       , KT$T"NUMERICNS"
                                       , KT$T"NUMERICLO"
                                       , KT$T"NUMERICLS"
                                       , KT$T"NUMERICTO"
                                       , KT$T"NUMERICTS"
                                       , KT$T"FLOAT"      # REAL       #
                                       ]; 
              ITEM  TYPEACT    I(1,0,10) =
                                       [ 1  # BINARY                   #
                                       , 2  # BINARY_BITS              #
                                       , 1  # INTEGER                  #
                                       , 2  # INTEGER_BITS             #
                                       , 1  # NUMERIC_LS               #
                                       , 1  # NUMERIC_NS               #
                                       , 1  # NUMERIC_LO               #
                                       , 1  # NUMERIC_LS               #
                                       , 1  # NUMERIC_TO               #
                                       , 1  # NUMERIC_TS               #
                                       , 1  # REAL                     #
                                       ]; 
          END 
  
CONTROL DISJOINT; 
  
CONTROL INERT;
  
CONTROL EJECT;
           F = ARRY$F[0]; 
           L = ARRY$L[0]; 
           T = ARRY$T[0]; 
           AD = ARRY$AD[0]; 
  
#     IF CALLED IN THE WRONG ORDER,                                    #
#         ISSUE A DIAGNOSTIC, AND                                      #
#         RETURN.                                                      #
  
          IF NOT S$INSEQ(SQ$"SM5KEY")  THEN 
              BEGIN 
              S$ERROR(E$110);          # CALL OUT OF SEQUENCE          #
#***#         RETURN; 
              END 
  
#     IF LESS THAN 1 OR MORE THAN 4 ORIGINAL PARAMETERS WERE GIVEN,    #
#         ISSUE A DIAGNOSTIC, AND                                      #
#         RETURN.                                                      #
  
          IF NPARMS LS 1
           OR NPARMS GR 4  THEN 
              BEGIN 
              S$ERROR(E$108);          # TOO FEW/MANY PARAMETERS       #
#***#         RETURN; 
              END 
  
#     IF LESS THAN 3 ORIGINAL PARAMETERS WERE GIVEN,                   #
#         F AND L REFER TO BYTES IN THE KEY FIELD.                     #
  
          IF NPARMS LS 3  THEN
              BEGIN 
              BYTEPOS = F;
              BITPOS  = 1;
              IF NPARMS LS 2  THEN
                  NBYTES = 1; 
              ELSE
                  NBYTES = L; 
              NBITS = 0;
              KEYTYPE = KT$T"DISPLAY";
              COLSEQ = "ASCII6";
              END 
          ELSE
                  # ELSE - THE USER HAS SPECIFIED THE TYPE OF          #
                  # KEY, WHICH MAY BE A KEYTYPE THAT WE RECOGNIZE,     #
                  # OR A COLLATING SEQUENCE ( HIS OR OURS), OR A       #
                  # BOO BOO                                            #
  
                  BEGIN 
                  S$BFILL(T); 
  
                  # LETS FIND OUT IF WE RECOGNIZE THE SPECIFIED KEY    #
  
                  FOUND = FALSE;
                  FOR I=1 STEP 1 WHILE (NOT FOUND) AND (I LQ NTYPES) DO 
                      IF T EQ TYPEVAL[I] THEN 
                      BEGIN 
                      HOLDI = I;        # REMEMBER VALUE OF I          #
                      FOUND = TRUE; 
                      END 
  
              # IF BOOLEAN VARIABLE 'FOUND' IS TRUE, THEN KEYTYPE      #
              # IS ONE OF OUR KEYTYPES - NOT A COLLATING SEQUENCE      #
              # OR AN ERROR                                            #
  
                  IF FOUND THEN 
                      BEGIN 
  
                      KEYTYPE = TYPEOPT[HOLDI]; 
                      COLSEQ = " "; 
  
                      IF TYPEACT[HOLDI] EQ 1 THEN 
  
                          # KEY IS SPECIFIED IN BYTES, NOT BITS        #
                          BEGIN 
                          BYTEPOS = F;
                          BITPOS = 1; 
                          NBYTES = L; 
                          NBITS = 0;
                          END 
  
                      ELSE
  
                          # KEY IS SPECIFIED IN BITS, NOT BYTES        #
                          BEGIN 
                          BYTEPOS = 1;
                          BITPOS = F; 
                          NBYTES = 0; 
                          NBITS = L;
                          END 
                      END 
                  ELSE
                          # NOT FOUND - SO WE'LL ASSUME THIS IS A      #
                          # COLLATING SEQUENCE                         #
                      BEGIN 
                      KEYTYPE = KT$T"DISPLAY";
                      BYTEPOS = F;
                      BITPOS = 1; 
                      NBYTES = L; 
                      NBITS = 0;
                      COLSEQ = T; 
                      END 
                  END 
  
#     SAVE RAW PARAMETER OF-                                           #
#         TYPE = RP$T"KEYNBYTEPOS",                                    #
#         GROUP = <NEW-GROUP>,                                         #
#         VALUE = BYTEPOS.                                             #
  
          RP$TYPE = RP$T"KEYBYTEPOS"; 
          GROUP = S$NEWGR;             # GET NEW GROUP NUMBER          #
          RP$GROUP = GROUP; 
          RP$VALUE = BYTEPOS; 
          S$SVREL(RP$); 
  
#     SAVE RAW PARAMETER OF-                                           #
#         TYPE = RP$T"KEYBITPOS",                                      #
#         GROUP = <SAME-GROUP>,                                        #
#         VALUE = BITPOS.                                              #
  
          RP$TYPE = RP$T"KEYBITPOS";
          RP$GROUP = GROUP;            # SAME GROUP                    #
          RP$VALUE = BITPOS;
          S$SVREL(RP$); 
  
#     SAVE RAW PARAMETER OF-                                           #
#         TYPE = RP$T"KEYNBYTES",                                      #
#         GROUP = <SAME-GROUP>,                                        #
#         VALUE = NBYTES.                                              #
  
          RP$TYPE = RP$T"KEYNBYTES";
          RP$GROUP = GROUP;            # SAME GROUP                    #
          RP$VALUE = NBYTES;
          S$SVREL(RP$); 
  
#     SAVE RAW PARAMETER OF-                                           #
#         TYPE = RP$T"KEYNBITS",                                       #
#         GROUP = <SAME-GROUP>,                                        #
#         VALUE = NBITS.                                               #
  
          RP$TYPE = RP$T"KEYNBITS"; 
          RP$GROUP = GROUP;            # SAME GROUP                    #
          RP$VALUE = NBITS; 
          S$SVREL(RP$); 
  
#     SAVE RAW PARAMETER OF-                                           #
#         TYPE = RP$T"KEYTYPE",                                        #
#         GROUP = <SAME-GROUP>,                                        #
#         VALUE = RP$VALUE DETERMINED ABOVE.                           #
  
          RP$TYPE = RP$T"KEYTYPE";
          RP$GROUP = GROUP;            # SAME GROUP                    #
          RP$VALUE = KEYTYPE; 
          S$SVREL(RP$); 
  
#     SAVE RAW PARAMETER OF-                                           #
#         TYPE = RP$T"KEYCOLSEQ",                                      #
#         GROUP = <SAME-GROUP>,                                        #
#         VALUE = COLSEQ.                                              #
  
          RP$TYPE = RP$T"KEYCOLSEQ";
          RP$GROUP = GROUP;            # SAME GROUP                    #
          RP$VALUEC = COLSEQ; 
          S$SVREL(RP$); 
  
#     IF THE *ORDER* PARAMETER WAS OMITTED,                            #
#         ASSUME IT IS ASCENDING                                       #
  
          IF NPARMS EQ 4 THEN 
              BEGIN 
              IF AD EQ "D" THEN 
                  BEGIN 
#         ONLY SAVE KEYORDER IF IT IS DESCENDING                       #
                  RP$TYPE = RP$T"KEYORDER"; 
                  RP$GROUP = GROUP; 
                  RP$VALUEC = AD;  # UNNECESSARY ?                     #
                  S$SVREL(RP$); 
                  END 
              END 
  
          END  # S$5KEY # 
          TERM
