*DECK S$5SUM
          PROC S$5SUM(NPARMS,F,L,T,REPEAT); 
#**       S$5SUM -  COLLECT SPECIFICATIONS OF A SUM FIELD              #
#                                                                      #
#     CALLING SEQUENCE-                                                #
#         CALL SM5SUM(F,L,T,REPEAT)                                    #
#           (THIS CALLS THE MACHINE-DEPENDENT ROUTINE SM5SUM           #
#            WHICH COUNTS PARAMETERS AND CALLS S$5SUM.)                #
#                                                                      #
#     GIVEN-                                                           #
#         NPARMS = NUMBER OF PARAMETERS ORIGINALLY SUPPLIED.           #
#         F = THE FIRST BYTE OR BIT OF THE FIELD.                      #
#         L = THE LENGTH OF THE SUM FIELD IN BITS OR BYTES             #
#         T = THE TYPE OF NUMERIC DATA TO BE SUMMED                    #
#         REPEAT = THE REPETITION FACTOR FOR THE SUM FIELD--           #
#                 IF THIS IS 2, FOR EXAMPLE, IT WOULD MEAN THAT        #
#                 TWO ADJACENT FIELDS WERE TO BE SUMMED, THE FIRST     #
#                 BEGINNING AT F, THE SECOND AT F + L, BOTH OF         #
#                 LENGTH L AND TYPE T                                  #
#                                                                      #
#     DOES-                                                            #
#         IF CALLED IN THE WRONG ORDER,                                #
#             ISSUE A DIAGNOSTIC, AND                                  #
#             RETURN.                                                  #
#         IF LESS THAN 3 OR MORE THAN 4 ORIGINAL PARAMETERS WERE GIVEN,#
#             ISSUE A DIAGNOSTIC, AND                                  #
#             RETURN.                                                  #
#             IF THE *REPEAT* PARAMETER WAS OMITTED, SETS IT TO 1,     #
#             WHICH MEANS NO REPETITION                                #
  
  
          BEGIN 
*CALL NPARMS
          ITEM  F            I;        # FIRST BYTE OF THE FIELD       #
          ITEM  L            I;        # LENGTH OF THE FIELD           #
          ITEM  T            C(10);    # SUM TYPE (MUST BE NUMERIC)    #
          ITEM  REPEAT       I;        # REPETITION FACTOR             #
  
          XREF
              BEGIN 
              PROC  S$BFILL;           # BLANK FILL PARAMETER          #
              PROC  S$ERROR;           # HANDLE A USER ERROR           #
              FUNC  S$INSEQ  B;        # TRUE IF  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 LEFTMOST BYTE IN FIELD #
          ITEM  GROUP        I;        # NUMBER OF CURRENT GROUP       #
          ITEM  I            I; 
          ITEM  SUMTYPE      I; 
          ITEM  NBITS        I;        # NUM. OF BITS SPECIF. BY BYTES #
          ITEM  NBYTES       I;        # NUM. OF BYTES IN THE FIELD    #
  
          DEF  NTYPES  #10#;
          ARRAY [1:10] S(2);
              BEGIN 
              ITEM TYPEVAL       C(0, 0,10)  =
                                       [ "INTEGER   " 
                                       , "INTEGER_BI" 
                                       , "NUMERIC_FS" 
                                       , "NUMERIC_NS" 
                                       , "NUMERIC_LO" 
                                       , "NUMERIC_LS" 
                                       , "NUMERIC_TO" 
                                       , "NUMERIC_TS" 
                                       , "BINARY    " 
                                       , "BINARY_BIT" 
                                       ]; 
              ITEM TYPEOPT       I(1,0,10)  = 
                                       [ KT$T"INTEGER"    # INTEGER    #
                                       , KT$T"INTEGER"    # INTEGERBITS#
                                       , KT$T"NUMERICFS"  # NUMERICFS  #
                                       , KT$T"NUMERICNS"  # NUMERICNS  #
                                       , KT$T"NUMERICLO"  # NUMERICLO  #
                                       , KT$T"NUMERICLS"  # NUMERICLS  #
                                       , KT$T"NUMERICTO"  # NUMERICTO  #
                                       , KT$T"NUMERICTS"  # NUMERICTS  #
                                       , KT$T"LOGICAL"    # BINARY     #
                                       , KT$T"LOGICAL"    # BINARYBITS #
                                       ]; 
          END 
  
CONTROL DISJOINT; 
  
CONTROL INERT;
  
CONTROL EJECT;
  
#     IF CALLED IN THE WRONG ORDER,                                    #
#         ISSUE A DIAGNOSTIC, AND                                      #
#         RETURN.                                                      #
  
          IF NOT S$INSEQ(SQ$"SM5SUM")  THEN 
              BEGIN 
              S$ERROR(E$110);          # CALL OUT OF SEQUENCE          #
#***#         RETURN; 
              END 
  
#     IF LESS THAN 3 OR MORE THAN 4 ORIGINAL PARAMETERS WERE GIVEN,    #
#         ISSUE A DIAGNOSTIC, AND                                      #
#         RETURN.                                                      #
  
          IF NPARMS LS 3
           OR NPARMS GR 4  THEN 
              BEGIN 
              S$ERROR(E$108);          # TOO FEW/MANY PARAMETERS       #
#***#         RETURN; 
              END 
  
          SUMTYPE = 0;
          S$BFILL(T); 
          FOR I=1 STEP 1 UNTIL NTYPES DO
              BEGIN 
              IF T EQ TYPEVAL[I]  THEN
                  BEGIN 
                  IF TYPEVAL[I] EQ "INTEGER_BI" 
                    OR TYPEVAL[I] EQ "BINARY_BIT" THEN
                      BEGIN 
                      BYTEPOS = 1;
                      BITPOS  = F;
                      NBYTES  = 0;
                      NBITS   = L;
                      SUMTYPE = TYPEOPT[I]; 
                      END 
                  ELSE
                      BEGIN 
                      SUMTYPE = TYPEOPT[I]; 
                      BYTEPOS = F;
                      BITPOS  = 1;
                      NBYTES  = L;
                      NBITS   = 0;
                      END 
                  END 
              END #FOR# 
          IF SUMTYPE EQ 0  THEN 
              BEGIN 
              S$ERROR(E$86);           # ILLEGAL SUM FIELD TYPE        #
#***#         RETURN; 
              END 
  
#     SAVE RAW PARAMETER OF-                                           #
#         TYPE = RP$T"SUMBYTEPOS"                                      #
#         GROUP = <NEW-GROUP>,                                         #
#         VALUE = BYTEPOS.                                             #
  
          RP$TYPE = RP$T"SUMBYTEPOS"; 
          GROUP = S$NEWGR;             # GET NEW GROUP NUMBER          #
          RP$GROUP = GROUP; 
          RP$VALUE = BYTEPOS; 
          S$SVREL(RP$); 
  
#     SAVE RAW PARAMETER OF-                                           #
#         TYPE = RP$T"SUMBITPOS",                                      #
#         GROUP = <SAME-GROUP>,                                        #
#         VALUE = BITPOS.                                              #
  
          RP$TYPE = RP$T"SUMBITPOS";
          RP$GROUP = GROUP;            # SAME GROUP                    #
          RP$VALUE = BITPOS;
          S$SVREL(RP$); 
  
#     SAVE RAW PARAMETER OF-                                           #
#         TYPE = RP$T"SUMNBYTES",                                      #
#         GROUP = <SAME-GROUP>,                                        #
#         VALUE = NBYTES.                                              #
  
          RP$TYPE = RP$T"SUMNBYTES";
          RP$GROUP = GROUP;            # SAME GROUP                    #
          RP$VALUE = NBYTES;
          S$SVREL(RP$); 
  
#     SAVE RAW PARAMETER OF-                                           #
#         TYPE = RP$T"SUMNBITS",                                       #
#         GROUP = <SAME-GROUP>,                                        #
#         VALUE = NBITS.                                               #
  
          RP$TYPE = RP$T"SUMNBITS"; 
          RP$GROUP = GROUP;            # SAME GROUP                    #
          RP$VALUE = NBITS; 
          S$SVREL(RP$); 
  
#     SAVE RAW PARAMETER OF-                                           #
#         TYPE = RP$T"SUMTYPE",                                        #
#         GROUP = <SAME-GROUP>,                                        #
#         VALUE = SUMTYPE.                                             #
  
          RP$TYPE = RP$T"SUMTYPE";
          RP$GROUP = GROUP;            # SAME GROUP                    #
          RP$VALUE = SUMTYPE; 
          S$SVREL(RP$); 
  
#         IF THE *REPEAT* PARAMETER WAS OMITTED, SET IT TO 1,          #
#         WHICH MEANS NO REPETITION                                    #
  
          IF NPARMS EQ 4  AND  REPEAT GR 0 THEN 
              RP$VALUE = REPEAT;
          ELSE
              RP$VALUE = 1; 
  
#     SAVE RAW PARAMETER OF-                                           #
#         TYPE = RP$T"SUMREP".                                         #
#         GROUP = <SAME-GROUP>,                                        #
#         VALUE = RP$VALUE DETERMINED ABOVE.                           #
  
          RP$TYPE = RP$T"SUMREP"; 
          RP$GROUP = GROUP;            # SAME GROUP                    #
          S$SVREL(RP$); 
  
  
          END # S$5SUM #
          TERM
