*DECK CUMFUNC 
USETEXT TCMMDEF 
USETEXT TCONVRT 
USETEXT TDESATT 
USETEXT TENVIRN 
USETEXT TEXPRES 
USETEXT TIMF
USETEXT TINDTBL 
USETEXT TPSTACK 
USETEXT TREPORT 
USETEXT TSBASIC 
USETEXT TXSTD 
      PROC CUMFUNC; 
#----------------------------------------------------------------------#
#                                                                      #
#  THE FOLLOWING PROCS ARE XDEF"D WITHIN THIS DECK:                    #
#                                                                      #
#     CUMFUN                       STORE CUMULATIVE FUNCTION CODE      #
#     CUMFUPM                      BUILD CUMULATIVE FUNCTION PARAMETERS#
#                                                                      #
#----------------------------------------------------------------------#
  
      BEGIN 
  
      XREF ITEM SAVEDESC     I;    # SAVED DESCRIBE LIST POINTER       #
      XREF ITEM DUMMY;                                                   SYNTAX 
          ITEM I,J,K; 
      XREF ITEM CURFUNC B;         # TRUE IF CURRENT ITEM IS FUNCTION  #
      XREF ITEM CURREG B;          # TRUE IF CURRENT-REGISTER          # QU3A334
      XREF ITEM ENDPTR       I;    # INDEX INTO EVALUATE TABLE         #
      XREF ITEM EVALFWA      I;    # FWA OF FIRST EVALUATE TABLE       #
      XREF ITEM FRMLFN       C(7); # LFN OF -OF- FILE                  #
      XREF ITEM FROMKEYINFIT I;    # ADDR OF FIT OF -OF- FILE          #
      XREF ITEM OLDSEARCH    B;    # TRUE IF PREVIOUS SAVED DIR EXISTS #
      XREF ITEM IMFDBM B;          # TRUE IF IN IMF DATABASE MODE      #
      ITEM RCSAVE;                 # SAVE RETURN CODE FROM 1ST TRYLOCA #
      ITEM SCALEDINT B;            # TRUE IF SCALED INTEGER            #
      ITEM SUMTYPE I;              # DATA TYPE OF SUM.  IF DATATYPE IS #
                                   # NUM, SCALED INTEGER, OR FIXED,    #
                                   # SUMTYPE = FLOATING                #
                                   # ELSE SUMTYPE = DATATYPE           #
      BASED ARRAY RESULT$FIELD;    # FOR LOOKING AT RESULT FIELD       #
        BEGIN 
        ITEM RESULT U(0,0,60);     # ONE WORD OF RESULT FIELD          #
        END 
      XREF BASED ARRAY EVALDATA;
        BEGIN 
        ITEM LOGRST B(0,0,1);      # LOGICAL RESULT                    #
        ITEM DATACNVT I(0,6,18);   # POINTER TO CONVERT TABLE          #
        ITEM DATASTACK I(0,24,18); # POINTER TO EXPRESSION STACK       #
        ITEM DATADEFADDR I(0,42,18);  # PTR TO ATTRIBUTE ARRAY         #
        ITEM EVALWD U(0,0,60);     # WHOLE EVALUATE ENTRY              #
        END 
      ITEM INDTBLEN I;             # LENGTH OF INDEX TABLE             #
      ITEM L I;                    # SCRATCH VARIABLE                  #
      ITEM MURALEN I;              # LENGTH OF MURAL IN WORDS          #
      ITEM RC I;                   # USED FOR RETURN STATUS CODES      #
      ITEM SVTYPALOW I;            # SAVED VALUE OF TYPEALOW           #
      ITEM TEMPEVALWD I;           # TEMP AREA FOR BUILDING EVAL ENTRY #
  
      BASED ARRAY MURALARRAY;      # MURAL                             #
        BEGIN 
        ITEM MURALENGTH U(0,55,05);  # LENGTH OF MURAL IN WORDS        #
        ITEM MURALWORD  I(0,00,60);  # ENTIRE WORD                     #
        END 
  
      BASED ARRAY NAME;            # ARRAY FOR COMPARING CUMULATIVE    #
                                   # FUNCTION NAME                     #
        BEGIN 
        ITEM DDATNAME C(0,0,10);   # ENTIRE WORD IN CHARACTER FORMAT   #
        ITEM DDATNAMI I(0,0,60);   # ENTIRE WORD IN INTEGER FORMAT     #
        END 
  
      ARRAY NAMEARRAY [0:0] S(1);  # WORK AREA FOR BUILDING THE NAME   #
        BEGIN 
        ITEM NEWNAM   C(0,00,10);  # ENTIRE NAME                       #
        ITEM INDEXLEN U(0,33,06);  # NUMBER OF WORDS IN INDEX TABLE    #
        END 
  
      XREF ITEM SM$GROUPID;        # GROUP ID OF CMM BLOCKS ALLOCATED  #
                                   # FOR THIS DIRECTIVE.               #
          XREF FUNC SAVATTR;
          ITEM SAVESM$GROUP;       # SAVE SM$GROUPID DURING CUM FUNC   #
  
  
      XREF PROC RECYES;            # RETURNS TO STDYES IF RECORDING    #
  
      CONTROL EJECT;
      XDEF PROC CUMFUN;                                                 017930
      PROC CUMFUN;                                                      017940
      BEGIN 
      IF FULLSYNTX                 # IF PREPARING A REPORT             #
        OR NOT STKFLAG             # OR NOT WORKING ON REPORT DIRECTIVE#
      THEN
        BEGIN 
        CURFUNC = TRUE;            # FLAG THAT DATANAME IS A FUNCTION  #
          CURREG = FALSE;                                                QU3A334
        I = CLXNUM[0];
          SVTYPALOW = TYPEALOW; 
          TYPEALOW = 6; 
                  #SAVE THE CUMULATIVE FUNCTION CODE#                   008940
        END 
            STDNO;                                                      017960
      END                                                               017970
      CONTROL EJECT;
          XREF PROC DDIAG;
      XDEF PROC CUMFUPM;                                                017980
                  #PROC TO PROCESS CUMULATIVE FUNCTION PARAMETERS       008960
                   BY MAKING A NEW ENTRY IN THE DEFINE OR DESCRIBE      008970
                   LIST, WITH THE NAME START WITH A -.-,FOLLOWED        008980
                   BY 9 BITS OF THE CUMULATIVE FUNCTION CODE, THEN      008990
                   FOLLOWED BY THE ADDRESS OF THE ATTRIBUTE OF THE      009000
                   PARAMETER#                                           009010
      PROC CUMFUPM;                                                     017990
      BEGIN                                                             018000
      ITEM SUM,COUNT;                                                   000320
      ITEM COUNTATTRIB I;          # ADDRESS OF COUNT ATTRIB TABLE     #
          BASED ARRAY STACKP  S(STKSIZE); 
                 #FOR BUILDING THE STACK#                               009050
              ITEM SENTY    U(0,00,03),                                 018040
                   SFCHAR   U(0,04,04),                                 018050
                   STCHAR   U(0,08,04),  # TO CHARACTER POSITION       #
                   SCHARLEN U(0,12,12),                                 018060
                   SFAD     U(0,24,18),                                 018070
                   STAD     U(0,42,18),                                 018080
                   SCVTN    U(1,00,06),                                 018090
          SSTAC U(1,6,18),
                   SADF     U(1,24,18),                                 018100
                   SADT     U(1,42,18),                                 018110
                   SPRKEY   B(2,00,01),  # TRUE IF PRIMARY KEY         #
                   SKEYEXCL B(2,01,01),  # TRUE IF EXCLUDED KEY        #
                   SRELORD  U(2,18,9),   # RELATION ORDINAL            #
                   SRECDORD U(2,27,12),  # RECORD ORD IF CDCS DATA NAME#
                                         # 1 IF CRM DATA NAME, ELSE 0  #
                   SITEMORD U(2,39,15),  # ITEM ORDINAL IF CDCS, ELSE 0#
                   SSKIPT   B(3,0,1),    #SKIP ON TRUE                 #
                   SSKIPF   B(3,1,1),    #SKIP ON FALSE                #
                   SSKIPAD  U(3,6,18),   #SKIP ADDRESS                 #
                   SWD1     U(0,00,60),                                 018120
                   SWD2     U(1,0,60),
                   SWD3     U(2,0,60),
                   SWD4     U(3,0,60);
      ARRAY [3];                       # FOR SAVING CURWORD.           #
        ITEM SAVE C(,,10);
*CALL DEFMURL 
          BASED ARRAY AT;                                               018140
              #FOR BUILDING ATTRIBUTES#                                 009070
              ITEM ATMPTR I(0,42,18),                                   018150
                   ATDPT I(0,21,06),  # DEIMAL POINT (SEE DPTLOC)      #
                   ATT    U(0,00,60),                                   018160
                   ATNLG  U(0,06,06);                                   018170
          ITEM PTPOS; 
      CONTROL EJECT;
          PROC TRYLOCA;                                                 018180
          BEGIN                                                         018190
              #PROC TO LOOK THRU THE DEF/DESC LIST TO SEE IF SUCH       009090
               A ENTRY IS ALREADY EXISTED, IF YES,RC=1,ELSE RC=0#       009100
          IF P<DESATT1> EQ 0 THEN GOTO NOTFOND; 
              RC = 1;                                                   018200
            LOOP1: # #                                                  018210
          P<NAME> = P<DESATT1> + 3; 
          IF DIMOCC[0]             # IF OCCURRING WORD EXISTS          #
          THEN
            BEGIN 
            P<NAME> = P<NAME> + 1;  # NAME IS AFTER OCCURRING WORD     #
            END 
  
          IF DDATNAME[0] EQ NEWNAM  # IF SAME NAME                     #
          THEN
            BEGIN 
            IF INDTBLEN NQ 0       # IF INDEX TABLE EXISTS             #
            THEN
              BEGIN 
              P<NAME> = P<NAME> + 1;  # POSITION TO INDEX TABLE        #
              FOR L = 0 STEP 1     # COMPARE ALL WORDS                 #
                UNTIL INDTBLEN - 1
              DO
                BEGIN 
                IF DDATNAME[L] NQ INDTBLWD[L]  # IF DIFFERENT SUBSCRIPT#
                THEN
                  BEGIN 
                  RC = 0;          # FLAG THAT NAME NOT FOUND          #
                  END 
                END 
              END 
  
            IF RC EQ 1             # IF NAME FOUND                     #
            THEN
              BEGIN 
              RETURN;              # RETURN WITH RC = 1                #
              END 
  
            ELSE
              BEGIN 
              RC = 1;              # RESET INITIAL ASSUMPTION THAT NAME#
                                   # WILL BE FOUND                     #
              END 
            END 
  
              IF DABSPTR[0] NQ 0 THEN                                   018230
              #DABSPTR EQ 0 MEANS END OF LIST REACHED#                  009140
              BEGIN P<DESATT1> = DABSPTR[0];                            018240
               #PICK UP NEXT ENTRY ON THE LIST, AND GO ON               009160
                CHECKING FOR THE NAME#                                  009170
                    GOTO LOOP1;                                         018250
              END                                                       018260
               #END OF LIST REACHED, NAME NOT FOUND,RETURN WITH         009190
                RC = 0#                                                 009200
        NOTFOND: # #
              RC = 0;                                                   018270
              RETURN;                                                   018280
          END                                                           018290
      CONTROL EJECT;
          PROC BUIDENTR;                                                018300
       #PROC TO BUILD AN ENTRY AT THE END OF THE LIST.WHEN THE          009220
        PROC IS ENTERED,-DESATT1- SHOULD BY POINTING TO THE LAST        009230
        ITEM ON THE LIST#                                               009240
          BEGIN                                                         018310
          SAVESM$GROUP = SM$GROUPID;
          SM$GROUPID = 0;          # DO NOT REQUEST CM BY GROUP ID     #
                                   # ALLOCATE CM FOR DEFINE LIST ENTRY #
                                   # AND INDEX TABLE                   #
          J = CMM$ALF (4 + INDTBLEN, 0, 0); 
          IF P<DESATT1> EQ 0 THEN DEFLIST = J;
          ELSE
              DABSPTR[0] = J;                                           018330
               #EXTEND THE LIST POINTER TO HAVE ONE MORE ENTRY#         009260
          IF SAVEDESC EQ P<DESATT1> THEN SAVEDESC = J;
              P<DESATT1> = J;                                           018340
              J = B<6,9>NEWNAM;                                         018380
              K = 10 * STKSIZE + 1;    # DEFAULT BLOCK SIZE            #
              IF DATATYPE EQ 0     # IF CHARACTER                      #
                AND J GR O"311"    # IF MINS/MAXS                      #
              THEN
                BEGIN 
                                   # BLOCK SIZE = 4 ELEMENTARY ENTRIES #
                                   # + 2 OPERANDS                      #
                K = 4 * STKSIZE + (2 * ((DATALENG + 9) / 10));
                END 
              P<STACKP> = CMM$ALF(K,0,0);  # REQUEST BLOCK FOR PROG STK#
               #J EQ THE CUMULATIVE FUNCTION CODE#                      009300
              SENTY[0] = 1;                                             018390
              SENTY[1] = 1;                                             018400
                #FIRST TWO ENTRY IN THE STACK ARE PARAMETERS,           009320
                 THE 3RD ONE IS FOR THE CUMULATION FUNCTION CODE        009330
                 THE 4TH ONE IS THE END OF STACK CODE#                  009340
              SENTY[2] = 7;                                             018410
              SENTY[3] = 7;                                             018420
              #FIRST ENTRY IS THE PARAMETER FOR THE CUMULATIVE          009360
               FUNCTION#                                                009370
          DDWORD0[0] = 0;                                               000150
          DDWORD1[0] = 0;                                               000160
              DECLASS[0] = DATATYPE;                                    018430
              SFCHAR[0] = DATACHARPOS;                                  018440
              SCHARLEN[0] = DATALENG;                                   018450
              SCHARLEN[1] = 10;                                         018460
              SPRKEY[0] = AKEYITEM;  # TRUE IF PRIMARY KEY             #
              SKEYEXCL[0] = EXCLKEYITEM;  # TRUE IF EXCLUDED KEY       #
              SRECDORD[0] = DATARECDORD;
              SITEMORD[0] = DATAITEMORD;
          IF AREAITM               # IF AREA ITEM                      #
          THEN
            BEGIN 
            DATANAMEPTR = SAVATTR; # MOVE RELATIVE ADDRESS TO ADDRESS  #
                                   # OF DEFDESC LIST ENTRY FOR DATANAME#
            END 
              P<AT> = DATANAMEPTR; # POSITION TO ATTRIBUTE TABLE       #
              IF DATATYPE EQ 2     # IF INTEGER                        #
                AND ATDPT[2] NQ 0   # IF SCALED                        #
              THEN
                BEGIN 
                SCALEDINT = TRUE; 
                END 
              ELSE
                BEGIN 
                SCALEDINT = FALSE;
                END 
          IF INDICED THEN BEGIN 
          SSTAC[0] = LOC(DDATNAM[0]) + 1;  # ADDRESS OF INDEX TABLE    #
          SFAD[0] = DATANAMEPTR;
          END ELSE
          BEGIN 
              SFAD[0] = DATAWORDADDR;                                   018470
              STAD[0] = DATAWORDADDR;                                   018480
          END 
              SADF[0] = DATANAMEBASE;                                   018490
              SADT[0] = DATANAMEBASE;                                   018500
                   IF FIGLITDATA EQ 3 THEN                              018510
                   BEGIN SADF[0]=LOC(CURRENTSOURC);                     018520
                         SADT[0]=LOC(CURRENTSOURC);                     018530
                   END                                                  018540
              FOR K = 1 STEP 1 UNTIL 3 DO                               018550
              # 4 * STKSIZE IS THE RESULT LOCATION                     #
              STAD[K] = P<STACKP> + 4 * STKSIZE;
              SFAD[1] = P<STACKP> + 4 * STKSIZE;
              SFAD[3] = 56;                                             018580
             #56 IS THE END OF STACK CODE#                              009410
              IF J EQ O"310" THEN    #COUNT#                            018590
              #RESULT OF COUNT IS ALWAYS INTEGER, AND THE FUNCTION      009430
               CODE FOR COUNT IS O"120"#                                009440
              BEGIN 
              DECLASS[0] = 2; 
              K = O"120"; 
              SCHARLEN[1] = 10; 
              SCHARLEN[2] = 10; 
              END 
              ELSE                                                      018610
              IF J GR O"311" THEN   #MINS/MAXS#                         018620
              #RESULT LENGTH FOR MINS/MAXS IS THE SAME AS THE           009460
               PARAMETER#                                               009470
              #O"150"-O"157" ARE FUNCTION CODE FOR MINS                 009480
               O"160"-O"167" ARE FUNCTION CODE FOR MAXS#                009490
              BEGIN SCHARLEN[1] = DATALENG;                             018630
              STCHAR[0] = DATACHARPOS;
              SCHARLEN[2] = DATALENG; 
          IF DATATYPE EQ DT$NUM    # IF NUMERIC                        #
            OR INDICED             # IF INDEXED                        #
          THEN
            BEGIN 
            IF INDICED             # IF INDEXED                        #
            THEN
              BEGIN 
              SENTY[0] = 4;        # *FIGSUB*ING REQUIRED              #
              END 
  
            ELSE
              BEGIN 
              SENTY[0] = 2;        # CONVERSION REQUIRED               #
              END 
  
            IF NOT AREAITM         # IF NOT AREA ITEM                  #
            THEN
              BEGIN 
              SADT[0] = 0;         # ZERO TOWORDBASE                   #
              END 
  
            IF DATATYPE EQ DT$CHAR  # IF CHARACTER DATA                #
            THEN
              BEGIN 
                                   # COMPUTE ADDRESS WHERE FIRST       #
                                   # OPERAND WILL BE STORED BY FIGSUB  #
              K = P<STACKP> + 4 * STKSIZE + ((DATALENG + 9) / 10);
              END 
  
            ELSE
              BEGIN 
                                   # COMPUTE ADDRESS WHERE FIRST       #
                                   # OPERAND WILL BE STORED BY FIGSUB  #
                                   # OR CONVERT                        #
              K = P<STACKP> + STKSIZE * 5;
              END 
  
                                   # EXPEVAL ALWAYS STORES MIN OR MAX  #
                                   # AT OPERAND2 WHICH HAS ALREADY BEEN#
                                   # SET TO P<STACKP>+16 AND AT RESULT #
            STAD[0] = K;           # CONVERSION OF 1ST OPERAND         #
            SFAD[0] = DATANAMEPTR;  # ATTRIB TBL OF 1ST OPERAND        #
            STAD[2] = K;           # RESULT                            #
            STAD[3] = K;           # RESULT                            #
            IF DATATYPE EQ DT$NUM  # IF 1ST OPERAND MUST BE CONVERTED  #
                                   # TO AND FROM FLOATING              #
            THEN
              BEGIN 
              SCHARLEN[1] = 10;    # LENGTH OF FLOATING                #
              SCHARLEN[2] = 10; 
              SCVTN[0] = B<24,6>CCODE[1];  # CONVERT FROM NUM TO FLOAT #
  
                                   # PREPARE CONVERT TABLE TO CONVERT  #
                                   # FROM FLOAT TO NUM AT P<STACKP>+24 #
  
              SFAD[6] = K;         # RESULTS OF CONVERSION WRITTEN     #
                                   # OVER SAME WORD WHERE FLOAT MIN/MAX#
                                   # WAS STORED                        #
              SCHARLEN[6] = PICSIZ[1];
              STAD[6] = P<DESATT1>;  # ATTRIB TBL FOR MIN/MAX          #
              SCVTN[6] = B<6,6>CCODE[4];  # CONVERT FROM FLOAT TO NUM  #
              SENTY[6] = 2;        # CONVERSION REQUIRED               #
              END 
            END 
  
                    K = O"130" + B<57,3>J * 8 + DATATYPE;               018640
              END                                                       018650
              ELSE                                                      018660
              IF J EQ O"307" THEN     #SUM#                             018670
              BEGIN 
              SCHARLEN[1] = 10; 
              SCHARLEN[2] = 10; 
              IF DATATYPE EQ 5     # IF DOUBLE                         #
                OR DATATYPE EQ 6   # IF COMPLEX                        #
              THEN
                BEGIN 
                SCHARLEN[1] = 20; 
                SCHARLEN[2] = 20; 
                END 
             #IF DOUBLE PRECISION, RESULT IS 20 CHARS LONG              009510
              NUMERIC OR SCALED INTEGER WILL BE CONVERTED INTO FLOATING 
              FIRST.#                                                   009530
             #0 IS CODE FOR INTEGER, O"20" FOR SINGLE,O"40"             009540
              FOR DOUBLE,O"60" FOR COMPLEX#                             009550
          IF DATATYPE EQ 3 THEN K=O"20";
          ELSE
                    IF DATATYPE LS 4 THEN K = 0;                        018690
                    ELSE K = 16 * DATATYPE - 48;                        018700
          IF DATATYPE EQ DT$NUM    # IF NUMERIC                        #
            OR DATATYPE EQ DT$FIXED  # IF FIXED                        #
            OR SCALEDINT           # IF SCALED INTEGER                 #
            OR INDICED             # IF INDEXED                        #
          THEN
            BEGIN 
            IF INDICED             # IF INDEXED                        #
            THEN
              BEGIN 
              SENTY[0] = 4;        # *FIGSUB*ING REQUIRED              #
              END 
  
            ELSE
              BEGIN 
              SENTY[0] = 2;        # CONVERSION REQUIRED               #
              END 
  
            IF NOT AREAITM         # IF NOT AREA ITEM                  #
            THEN
              BEGIN 
              SADT[0] = 0;         # ZERO TOWORDBASE                   #
              END 
  
            SFAD[0] = DATANAMEPTR;  # ATTRIB TBL OF 1ST OPERAND        #
            STAD[0] = P<STACKP> + 5 * STKSIZE;
            IF DATATYPE EQ DT$NUM  # IF 1ST OPERAND MUST BE CONVERTED  #
                                    # TO FLOATING                      #
              OR DATATYPE EQ DT$FIXED  # IF FIXED                      #
              OR SCALEDINT
            THEN
              BEGIN 
              K = 16;              # FLOATING POINT ADDITION           #
              SCVTN[0] = B<24,6>CCODE[DATATYPE];  # CONVERT TO FLOAT PT#
              END 
  
            IF DATATYPE EQ DT$NUM  # IF RESULT MUST BE CONVERTED FROM  #
                                   # FLOATING TO NUMERIC               #
                                   # PREPARE CONVERT TABLE TO CONVERT  #
                                   # FROM FLOAT AT P<STACKP> + 24      #
            THEN
              BEGIN 
              SENTY[6] = 2;        # CONVERSION REQUIRED               #
              SCHARLEN[6] = PICSIZ[DATATYPE]; 
              SFAD[6] = P<STACKP> + 4 * STKSIZE;  # RESULT OF SUM      #
              STAD[6] = P<DESATT1>;  # ATTRIB TABLE FOR SUM            #
              SCVTN[6] = B<DATATYPE*6,6>CCODE[4];  # CONVERT FROM FLOAT#
              END 
            END 
  
              END                                                       018830
              ELSE                                                      018840
              #MEAN#                                                    009590
          BEGIN 
          SCHARLEN[1] = 10; 
              SCHARLEN[2] = 10; 
          IF DATATYPE EQ 5         # IF DOUBLE                         #
            OR DATATYPE EQ 6       # IF COMPLEX                        #
          THEN
            BEGIN 
            SCHARLEN[1] = 20; 
            SCHARLEN[2] = 20; 
            END 
          K = SUM + 4 * STKSIZE;
          STAD[0]=K;
          SFAD[0]=K;
          # SUM + 16 IS THE LOCATION OF THE SUM RESULT, USE AS 1ST PARM#
          K = COUNT + 4 * STKSIZE;
          STAD[1]=K;
          SFAD[1]=K;
          # COUNT + 16 IS THE LOCATION OF THE COUNT, USE THIS 
                 AS THE 2ND PARAMETER#                                  009670
          IF DATATYPE NQ 2         # IF NOT INTEGER                    #
            OR SCALEDINT           # IF SCALED INTEGER                 #
          THEN
                                   # IF SUM IS NOT UNSCALED INTEGER,   #
                                   # SET UP CONVERSION TABLE TO CONVERT#
                                   # COUNT TO SAME TYPE AS SUM         #
                   BEGIN SENTY[1] = 2;                                  018900
          IF DATATYPE LS 4 THEN K=4;
          ELSE K = DATATYPE;
          SFAD[1] = COUNTATTRIB;   # FROM ADDR CONTAINS ATTRIB TBL ADDR#
          SCVTN[1] = B<K * 6,6>CCODE[2];
          K = 16 * K - 45;
                   #SET UP FUNCTION CODE ACCORDING TO TYPE#             009720
                   STAD[1] = CMM$ALF(2,0,0);
                   END                                                  018940
                   ELSE K = 3;                                          018950
                   #3 IS INTEGER DIVISION#                              009740
        IF DATATYPE EQ DT$NUM      # IF NUMERIC                        #
          OR DATATYPE EQ DT$FIXED  # IF FIXED                          #
          OR SCALEDINT             # IF SCALED INTEGER                 #
        THEN                       # CONVERT FROM FLOATING TO NUM OR I #
          BEGIN 
          SENTY[6] = 2; 
          SCHARLEN[6] = PICSIZ[1];
          SFAD[6] = P<STACKP> + 4 * STKSIZE;
                       STAD[6] = P<DESATT1>;                            019010
          SFAD[0] = DATANAMEPTR;
          SCVTN[6] = B<DATATYPE*6,6>CCODE[4]; 
                   END                                                  019030
                  SADT[0] = 0; SADF[0] = 0;                             019040
              END                                                       019050
               SFAD[2] = K;                                             019060
                #PUT FUNCTION CODE IN STACK#                            009780
              DECNLG[0] = 6;                                            019080
              DEWNLG[0] = 1;                                            019090
              DDATNAM[0] = NEWNAM;                                      019100
                #STORE NAME AND LENGTH IN DEF/DESC ENTRY#               009800
              DECLSLG[0] = DATALENG;                                    019110
              IF INDTBLEN NQ 0     # IF INDEXED TABLE EXISTS           #
              THEN
                BEGIN 
                P<NAME> = LOC(DDATNAM[0]) + 1;  # POSITION OF INDEX TBL#
                FOR L = 0 STEP 1
                  UNTIL INDTBLEN - 1
                DO
                  BEGIN 
                  DDATNAMI[L] = INDTBLWD[L];  # COPY INDEX TABLE TO    #
                                              # DEFINE ENTRY           #
                  END 
                END 
  
              P<AT> = DATANAMEPTR;                                      019120
              DDWORD2[0] = ATT[2];                                      019130
              DIMOCC[0] = FALSE;   # CUMULATIVE FUNCTION IS NOT AN     #
                                   # OCCURRING ITEM, BECAUSE, EVEN IF  #
                                   # ARGUMENT IS OCCURRING, CUM FUNC   #
                                   # IS COMPUTED FOR SPECIFIC          #
                                   # OCCURRENCE                        #
              IF J EQ O"310"       # IF COUNT                          #
              THEN
                BEGIN 
                DPTLOC[0] = 0;     # COUNT IS NEVER SCALED             #
                END 
          IF ATMPTR[2] NQ 0        # IF MURAL EXISTS                   #
            AND J NQ O"310"        # NOT COUNT                         #
            AND J NQ O"307"        # NOT SUM                           #
          THEN
                                   # IF NOT *COUNT* OR *SUM* AND MURAL #
                                   # EXISTS, ALLOCATE CM TO COPY IT TO #
            BEGIN 
            P<MURALARRAY> = P<AT> + ATMPTR[2];  # POSITION TO OLD MURAL#
            MURALEN = MURALENGTH;  # LENGTH OF MURAL IN WORDS          #
            P<AT> = P<MURALARRAY>;  # POSITION TO OLD MURAL            #
                                   # ALLOCATE CM FOR NEW MURAL         #
            P<MURALARRAY> = CMM$ALF (MURALEN, 0, 0);
            MURALPTR[0] = P<MURALARRAY> - P<DESATT1>;  # OFFSET TO NEW #
                                                       # MURAL         #
            FOR L = 0 STEP 1       # COPY ENTIRE MURAL                 #
              UNTIL MURALEN - 1 
            DO
              BEGIN 
              MURALWORD[L] = ATT[L];  # COPY MURAL                     #
              END 
            END 
  
          ELSE BEGIN MURALPTR[0] = 0;                                   000180
          END                                                           000290
          IF J EQ O"307"           # IF SUM                            #
          THEN
            BEGIN 
            IF DATATYPE EQ DT$NUM      # IF NUMERIC                    #
              OR DATATYPE EQ DT$FIXED  # IF FIXED, ALIAS COMP-1        #
              OR SCALEDINT             # IF SCALED INTEGER             #
            THEN
              BEGIN 
              SUMTYPE = DT$FLOAT;  # USE DEFAULT PIC FOR FLOATING      #
              END 
  
            ELSE
              BEGIN 
              SUMTYPE = DATATYPE;  # SUM OF ITEM IS SAME TYPE AS ITEM  #
              END 
  
            DPICSIZ[0] = PICSIZ[SUMTYPE];  # DEFAULT PICTURED SIZE     #
            DISPLAYSIZE[0] = DISPSIZ[SUMTYPE];  # PIC SIZE LESS        #
                                                # INSERTED CHARACTERS  #
            DPTLOC[0] = DECPT[SUMTYPE];  # DECIMAL POINT LOCATION      #
            IF DECPT[SUMTYPE] NQ 0  # DEC PT LOCATION NOT AT RIGHT     #
            THEN
              BEGIN 
              DPOINT[0] = TRUE;    # DECIMAL POINT FLAG                #
              END 
            ELSE
              BEGIN 
              DPOINT[0] = FALSE;
              END 
            IF DEFMURAL[SUMTYPE] NQ 0  # IF DEFAULT MURAL REQUIRED     #
            THEN
              BEGIN 
              P<AT> = CMM$ALF(1,0,0);  # ALLOCATE SPACE FOR MURAL      #
              MURALPTR = P<AT> - P<DESATT1>;  # STORE REL PTR TO MURAL #
              ATT[0] = DEFMURAL[SUMTYPE];  # STORE DEFAULT MURAL       #
              END 
            ELSE
              BEGIN 
              MURALPTR = 0;        # NO MURAL                          #
              END 
            IF DATATYPE EQ 1       # IF NUMERIC                        #
            THEN
              BEGIN 
              DECLSLG[0] = DISPSIZ[SUMTYPE];  # NUM CHARS EXCLUDING    #
                                              # INSERTED CHARACTERS    #
              END 
  
            END 
              DEXPPTR[0] = P<STACKP>;                                   019210
                 #SAVE STACK AND RESULT LOCATION IN ENTRY#              009860
          VALULOC[0] = P<STACKP> + 4 * STKSIZE; 
          IF (J NQ O"310"                # IF NOT COUNT                #
              AND DATATYPE EQ DT$NUM)    # IF NUMERIC                  #
            OR (J EQ O"311"              # IF MEAN                     #
              AND (DATATYPE EQ DT$FIXED  # IF FIXED                    #
                OR SCALEDINT))           # IF SCALED INTEGER           #
          THEN
            BEGIN 
                                   # CONVERT TABLE TO CONVERT FROM     #
                                   # FLOATING TO INT.NUMBER, FIXED     #
            DCNVTBL[0] = P<STACKP> + 6 * STKSIZE; 
                                   # LOCATION OF CONVERTED VALUE       #
            VALULOC[0] = P<STACKP> + 5 * STKSIZE; 
            END 
  
       IF J NQ O"310" THEN BEGIN #IF NOT COUNT# 
          P<AT>=VALULOC[0];    #NOW PRESET THE RESULT#
          IF DATATYPE EQ 1 THEN ATT[0] = O"33333333333333333333"; 
          ELSE
          IF DATATYPE NQ 2 THEN ATT[0] = O"20000000000000000000"; 
          ATT[1]=ATT[0];
       END
        ELSE
          BEGIN 
                                   # SET UP EDITING FOR *COUNT*        #
          DISPLAYSIZE[0] = 10;     # SIZE OF UNEDITED PICTURE          #
          DPICSIZ[0] = 10;         # SIZE OF EDITED PICTURE            #
                                   # ALLOCATE CM FOR 1 WORD MURAL      #
          P<MURALARRAY> = CMM$ALF (1, 0, 0);
          MURALWORD[0] = O"44677604000000000001";  # MURAL FOR Z(9)9   #
          MURALPTR[0] = P<MURALARRAY> - P<DESATT1>;  # OFFSET TO MURAL #
          END 
          SM$GROUPID = SAVESM$GROUP;  # RESTORE SM$GROUPID             #
               #ENTRY IS ALL DONE,RETURN#                               009880
          END                                                           019270
      CONTROL EJECT;
  
  
  
  
#-------------------EXECUTABLE CODE FOR CUMFUPM------------------------#
  
  
  
  
      IF FULLSYNTX                 # IF PREPARING A REPORT             #
        OR NOT STKFLAG             # OR NOT WORKING ON REPORT DIRECTIVE#
      THEN
          BEGIN 
          RECYES;                  # RETURN TO STDYES IF RECORDING     #
          P<DESATT1> = DATANAMEPTR; 
          PTPOS = DPTLOC[0];
          IF SVTYPALOW NQ 0 THEN
          BEGIN TYPEALOW = SVTYPALOW; 
                SVTYPALOW = 0;
          END 
          IF (I NQ O"310" AND DATATYPE EQ 7) OR                         019280
          FALL OR FANY
           OR 
              #IF NOT -COUNT- AND TYPE IS LOGICAL OR IF (SUM            009900
               OR MEAN) AND TYPE IS CHAR, ILLEGAL PARAMETER#            009910
            ((I EQ O"307" OR I EQ O"311") AND DATATYPE EQ 0) THEN       019290
          BEGIN DDIAG(68);
             STDNO;                                                     019300
           END
          P<DESATT1> = DEFLIST;    # CUM FUNCTIONS ON DEFINE LIST      #
          NEWNAM = "          ";                                        019340
               #MAKE UP THE NAME#                                       009960
          B<6,9>NEWNAM = I;                                             019360
          IF NOT AREAITM THEN 
          BEGIN C<0>NEWNAM = "."; 
                B<15,18>NEWNAM = DATANAMEPTR; 
          END 
          ELSE
          BEGIN C<0>NEWNAM = ","; 
                B<15,18>NEWNAM = DIRWORDADDR; 
          END 
          IF INDICED               # IF SUBSCRIPTED ITEM               #
          THEN
            BEGIN 
            P<INDTBL> = INDCTBLOC;  # POSITION TO INDEX TABLE          #
            INDTBLEN = TBLGS[0];    # LENGTH OF INDEX TABLE            #
            INDEXLEN = TBLGS[0];    # LENGTH OF INDEX TABLE            #
            END 
  
          ELSE
            BEGIN 
            INDTBLEN = 0;           # NO INDEX TABLE                   #
            END 
  
          TRYLOCA;                                                      019380
              #CHECK IF THE ENTRY ALREADY EXISTED, IF YES,GO            009980
               SET UP INFORMATIONS IN CEXPRESS,ELSE#                    009990
          RCSAVE = RC;             # SAVE RETURN CODE FROM TRYLOCA     #
          IF I EQ O"311" THEN                                           019400
              #IF -MEAN-,HAD TO MAKE SURE -SUM- AND -COUNT-             010030
               ALREADY EXISTED BEFORE BUILD UP THE ENTRY FOR            010040
               -MEAN-#                                                  010050
          BEGIN                                                         019410
              B<6,9>NEWNAM = O"307";                                    019420
              P<DESATT1> = DEFLIST; 
              TRYLOCA;                                                  019440
                  #CHECK IF -SUM- EXISTED#                              010070
              IF RC EQ 0 THEN BUIDENTR;                                 019450
                  #BUILD ENTRY FOR -SUM- IF NOT EXISTED#                010090
              AUTOEVAL;            # IF EVALUATE DIRECTIVE, AUTOMATICAL#
                                   # EVALUATE SUM IF IT HAS NOT ALREADY#
                                   # BEEN EVALUATED                    #
              SUM = DEXPPTR[0];                                         019460
              B<6,9>NEWNAM = O"310";                                    019470
              P<DESATT1> = DEFLIST; 
                  #CHECK IF -COUNT- EXISTED#                            010110
              TRYLOCA;                                                  019490
              IF RC EQ 0 THEN BUIDENTR;                                 019500
                  #BUILD ENTRY FOR -COUNT- IS NOT EXISTED#              010130
              AUTOEVAL;            # IF EVALUATE DIRECTIVE, AUTOMATICAL#
                                   # EVALUATE COUNT IF IT HAS NOT      #
                                   # ALREADY BEEN EVALUATED            #
              COUNT = DEXPPTR[0];                                       019510
              COUNTATTRIB = LOC(DESATT1);  # SAVE COUNT ATTRIB TBL ADDR#
              B<6,9>NEWNAM = I;                                         019520
              P<DESATT1> = DEFLIST; 
              TRYLOCA;
                  #THIS LAST -TRYLOCA- IS JUST TO LOCATED THE           010150
                   POINTER TO END OT THE DEF/DESC LIST#                 010160
          END                                                           019540
          IF RCSAVE EQ 0           # IF ENTRY DID NOT EXIST            #
          THEN
            BEGIN 
            BUIDENTR;              # BUILD ENTRY                       #
            END 
             #SET INFORMATION IN CEXPRESS, AND RETURN#                  010180
          PROGSTACKLOC = 0;                                             019570
          PROGSTACKLEN = -1;                                            019580
          LOGICALRESLT = FALSE;                                         019590
          IF I EQ O"310"           # IF COUNT                          #
          THEN
            BEGIN 
            DATATYPE = 2;          # RESULT IS ALWAYS INTEGER          #
  
            DATANAMEUSE = 1;       # SETTING THE USAGE TYPE TO NUMERIC #
                                   # WILL AVOID THE ERROR MESSAGE (72) #
                                   # GIVEN BY THE OPERATOR IN EXPANAL. #
                                   # CHARACTER DATA TYPES ARE ILLEGAL  #
                                   # FOR ALL BUT ONE CUMULATIVE FUNC-  #
                                   # TION, THE COUNT.                  #
            END 
  
          IF I EQ O"307"           # IF SUM                            #
            AND (DECLASS EQ DT$FIXED     # IF FIXED                    #
              OR (DECLASS EQ DT$INTEGER  # IF SCALED INTEGER           #
                AND DPTLOC NQ 0)) 
          THEN
            BEGIN 
            DATATYPE = DT$FLOAT;   # SUM IS FLOATING                   #
            END 
  
          DATACHARPOS = 0;                                              019610
          ABSADDRESS = TRUE;                                            019620
            FIGLITDATA = 2;                                             019630
          DATANAMEPTR = P<DESATT1>;                                     019640
          DATANAMEBASE = 0;                                             019650
          DATAWORDADDR = VALULOC[0];                                    019660
          DATALENG = DECLSLG[0];                                        019670
          RESULTSIZE = DPICSIZ[0];                                      019680
          INDICED = FALSE;         # CUM FUNCTION IS NOT OCCURRING     #
          IF DIRLEXID NQ O"133"    # IF NOT *EVALUATE*                 #
          THEN
            BEGIN 
            AREAITM = FALSE;       # CUM FUNC IS DEFINED ITEM          #
            DESITM = FALSE; 
            IF NOT OLDSEARCH       # IF 1ST SAVED DIRECTIVE IN XMISSN  #
            THEN
              BEGIN 
              DESPASS = FALSE;     # REMOVE REFERENCES TO -FROM- FILE  #
              FROMKEYINFIT = 0; 
              FRMLFN = " "; 
              END 
  
            IF IMFDBM              # IF IN IMF DATABASE MODE           #
            THEN
              BEGIN 
                                   # CLEAR RECORD ACCESS INDICATOR     #
              RECORDSEEN[RECORDID] = FALSE; 
              END 
            END 
          END 
          STDYES;                                                       019690
      END                                                               019700
      CONTROL EJECT;
#----------------------------------------------------------------------#
#     PROC  AUTOEVAL                                                   #
#                                                                      #
#     IF PROCESSING EVALUATE DIRECTIVE, SCAN EVALUATE TABLE FOR AN     #
#     EVALUATE ENTRY FOR THE FUNCTION (COUNT OR SUM) WHOSE ATTRIBUTE   #
#     ARRAY IS POINTED TO BY P<DESATT1>.  IF FOUND, EXIT.  IF NOT      #
#     FOUND, INSERT ITS EVALUATE ENTRY INTO THE EVALUATE TABLE         #
#                                                                      #
#----------------------------------------------------------------------#
  
      PROC AUTOEVAL;
      BEGIN 
      ITEM I;                      # INDEX INTO EVALUATE TABLE         #
  
      IF FULLSYNTX                 # IF PREPARING REPORT               #
      THEN
        BEGIN 
        IF B<42,6>KEYAREA NQ O"33"  # IF NOT EVALUATE                  #
        THEN
          BEGIN 
          RETURN; 
          END 
        END 
      ELSE
        BEGIN 
        IF DIRLEXID NQ O"133"      # IF NOT EVALUATE                   #
          OR RECORDFLAG            # IF RECORDING                      #
          OR STKFLAG               # IF CATALOGING REPORT DIRECTIVES   #
        THEN
          BEGIN 
          RETURN; 
          END 
        END 
                                   # REINITIALIZE SUM OR COUNT         #
      P<PROGRAMSTACK> = DEXPPTR;   # PICK UP STACK ADDRESS             #
      P<RESULT$FIELD> = TOWORDADDR[2];  # PICK UP RESULT ADDRESS       #
      RESULT[0] = 0;               # RESET SUM OR COUNT TO 0           #
      RESULT[1] = 0;
  
      P<EVALDATA> = LOC(TEMPEVALWD);  # PREPARE EVALUATE TABLE ENTRY   #
                                      # IN TEMPORARY WORD              #
      LOGRST = FALSE;              # LOGICAL RESULT IS FALSE           #
      DATACNVT = DCNVTBL;          # PTR TO CONVERT TABLE              #
      DATASTACK = DEXPPTR;         # PTR TO EXPRESSION STACK           #
      DATADEFADDR = P<DESATT1>;    # PTR TO ATTRIBUTE ARRAY            #
      P<EVALDATA> = EVALFWA;       # POSITION TO FWA OF 1ST EVAL TBL   #
      I = 0;                       # INITIALIZE INDEX                  #
      FOR DUMMY = DUMMY 
        WHILE TRUE
      DO                           # SCAN EVALUATE TABLE TO SEE IF THIS#
                                   # FUNCTION HAS ALREADY BEEN         #
                                   # EVALUATED                         #
        BEGIN 
        IF EVALWD[I] EQ 0          # IF SCANNED TO END OF TABLE        #
                                   # WITHOUT A HIT, INSERT EVALUATE    #
                                   # ENTRY INTO TABLE                  #
        THEN
          BEGIN 
          IF ENDPTR EQ 6           # IF END OF CURRENT BLOCK           #
          THEN
            BEGIN 
            DATADEFADDR[6] = CMM$ALF(7,0,SM$GROUPID);  # REQUEST NEXT  #
                                                       # 7 WORD BLOCK  #
            P<EVALDATA> = DATADEFADDR[6]; 
            ENDPTR = 0;            # RESET INDEX FOR NEW BLOCK         #
            END 
          EVALWD[ENDPTR] = TEMPEVALWD;  # INSERT EVAL ENTRY INTO TABLE #
          ENDPTR = ENDPTR + 1;
          RETURN; 
          END 
  
        IF EVALWD[I] EQ TEMPEVALWD       # FUNC ALREADY EVALUATED      #
        THEN
          BEGIN 
          RETURN; 
          END 
  
        I = I + 1;                 # INCREMENT TO NEXT EVAL ENTRY      #
        IF EVALWD[I] EQ 0 
        THEN
          BEGIN 
          TEST DUMMY; 
          END 
        IF I EQ 6                  # IF END OF CURRENT BLOCK           #
        THEN
          BEGIN 
          P<EVALDATA> = DATADEFADDR[6];  # POSITION TO NEXT BLOCK      #
          I = 0;                   # RESET INDEX FOR NEXT BLOCK        #
          END 
        TEST DUMMY;                # LOOP BACK FOR NEXT ENTRY          #
        END 
      END 
  
      END 
      TERM
