*DECK SPEDEDE 
USETEXT TCMMDEF 
USETEXT TCONVRT 
USETEXT TDESATT 
USETEXT TENVIRN 
USETEXT TEXPRES 
USETEXT TINDTBL 
USETEXT TLFNINF 
USETEXT TOPTION 
USETEXT TXSTD 
      PROC SPEDEDE; 
  
#----------------------------------------------------------------------#
#                                                                      #
#  THE FOLLOWING PROCS ARE XDEF"D WITHIN THIS DECK:                    #
#                                                                      #
#     AMBIGNAME                    PREPARE FOR AMBIG. NAME IN DEPENDING#
#     DEPON                        PROCESS *DEPENDING* OPTION          #
#     DISDATA                      FLAG DATA AS *DISPLAY* TYPE         #
#     DN2DEDE                      NEW ENTRY FOR DEFINE / DESCRIBE     #
#     INIDEF                       INITIALIZE FOR A *DEFINE*           #
#     INIDESC                      INITIALIZE FOE A *DESCRIBE*         #
#     INISPECIFY                   INITIALIZE FOR A *SPECIFY*          #
#     INTDEDE                      SAVE INTEGER *OCCURS* COUNT         #
#     LINKDESLFN                   LINK NEW DESCRIBED LFN INTO LFNLIST #
#     NEXTARR                      PROCESS NEXT ARRAY PRESET FOR DEFINE#
#     PICDEDE                      PICTURE SAVING FOR DEFINE / DESCRIBE#
#     RESTARR                                                          #
#     RETENTRY                     FREES DEF/DESC CORE AFTER ERRORS    #
#     RSETDES                      RESET DESCRIBE PTRS FOR *OR* OPTION #
#     TYPDEDE                      SAVE DATA TYPE OF DEF/DESC ITEM     #
#     XEQDEF                       BUILD A *DEFINE* ENTRY AND LINK IT  #
#     XEQSPECIFY                   STORE STACK PTRS IN SPECIFY ENTRY   #
#                                                                      #
#----------------------------------------------------------------------#
  
      BEGIN 
  
      XREF ITEM ALTERKEY     B;    # TRUE IF ALTERNATE KEY ITEM        #
      XREF ITEM CURRENTLFPTR I;    # POINTER TO LFNINFO ENTRY FOR LFN  #
      XREF ITEM DEFLIST      I;    # POINTER TO HEAD OF DEFINE LIST    #
      XREF ITEM DESLIST I;         # DESCRIBE LIST PTR FOR CURRENT LF  #
      XREF ITEM DUMMY;
      XREF ITEM LFNLIST;           # ADDRESS OF FIRST DESCRIBE LIST    #
      XREF ITEM SM$GROUPID I;      # CMM GROUP ID                      #
      ITEM DISFLAG      B;         # TRUE IF *DISPLAY* <TYPE>          #
      ITEM FL           I;
      ITEM ORBIT        B;
*CALL DEFMURL 
      XREF ITEM CMM$PRS      I;    # CMM$ALF PRESETS TO THIS VALUE     #
      XREF ITEM PRIMKEY      B;    # TRUE IF PRIMARY KEY ITEM          #
      XREF ITEM SAVEDESC     I; 
      XREF ITEM SPELIST      I;    # POINTER TO HEAD OF SPECIFY LIST   #
  
      XREF BASED ARRAY DESPTR;     # ENTRY FOR EACH DESCRIBE LIST      #
        BEGIN 
                                   # NUMBER OF LOCAL FILES REFERENCING #
        ITEM DESCOUNT I(00,00,12); # THIS LIST OF DESCRIBED ITEMS      #
        ITEM DESSIZE  U(00,24,18); # SIZE OF DESCRIBED LIST IN CHARS   #
        ITEM DESADDR  U(00,42,18); # ADDRESS OF LIST OF ITEMS          #
        END 
  
      XREF
        BEGIN 
        BASED ARRAY ANAME2[1:4];;  # TO PASS DATANAME TO -SEARCH-      #
  
        ARRAY FIELDN[1:FIELDNAMEMAX] S(4);
          BEGIN 
          ITEM FN  C(0,0,10);      # NAME OF CURRENT ITEM              #
          END 
  
          ARRAY PICTEMP;               # CONTAINS MURAL BUILT BY PICTUR#
            ITEM PIC I(,,60); 
      ARRAY SQASHBU S(9);          # INFO ABOUNT PICTURE               #
            ITEM EXTCOUNT I(0,,60),    # PICTURED LENGTH (EXTERNAL)    #
            PTLOC I(1,0,60),   #PT LOCATION#
                 MURLENG  I(4,,60),    # LENGTH OF MURAL IN WORDS      #
                 INSERTS  I(5,,60),    # NR INSERT CHARS IN PICTURE    #
                 SIGNFLAG I(6,,60),    # NON-ZERO IF S FOUND IN PICTURE#
                 PICSIGN  I(8,,60);    # NZ IF CR,DB,+,- IN PICTURE    #
      END 
      BASED ARRAY ADDR; 
        BEGIN 
        ITEM ADDRLG  I(00,42,18);  # DATA LENGTH IN CHARS              #
        ITEM ADDREW  I(00,00,60);  # FULL WORD ENTRY                   #
        END 
      BASED ARRAY DESATT2 [0:1];
          ITEM DEDMUR   I(0,0,60);      #EDIT MURAL#
      BASED ARRAY DESATT3;         # ATTRIBUTE TABLE                   #
        BEGIN 
        ITEM DPTLOC3 I(2,21,6);    # LOCATION OF DECIMAL POINT         #
        END 
      BASED ARRAY MOVETABLE [0] S(EESIZE);
        ITEM ENTRYCODE U(0,0,3),
             MEDIT     B(0,3,1),
             FCHAR     U(0,4,4),
             TCHAR     U(0,8,4),
             NBRCHARS  U(0,12,12),  # LENGTH OF FIELD IN CHARACTERS    #
             FWORD     I(0,24,18),
             TWORD     I(0,42,18),
             CONCODE   U(1,0,6),
             STACKADD  I(1,6,18),  # ADDRESS OF INDEX TABLE            #
             FBASE     I(1,24,18),
             PRKEY     B(2,0,1),   # TRUE IF PRIMARY KEY               #
             MKEYEXCL  B(2,1,1),   # TRUE IF PART/ALL OF EXCLUDED KEY  #
             MRECDORD  U(2,27,12), # RECORD ORDINAL IF CDCS AREA ITEM  #
                                   # 1 IF CRM AREA ITEM, ELSE 0        #
             MITEMORD  U(2,39,15), # ITEM ORD IF CDCS AREA ITEM, ELSE 0#
             M0        I(0,0,60), 
             M1        I(1,0,60); 
      ARRAY ATTRIB [0:0] S(2);     # ATTRIB TABLE FOR CONVERT          #
        BEGIN 
        ITEM ATTRWP I(0,18,18);    # BEGINNING WORD POSITION           #
        END 
      BASED ARRAY MR;              # BASED ARRAY FOR MURAL             #
        BEGIN 
        ITEM MURL I(0,0,60);       # MURAL WORD                        #
        END 
      STATUS CURRENTDIR DEFINE,DESCRIBE,SPECIFY;
      ITEM ATTRPTR I;              # PARAMETER OF -SEARCH- WHICH HOLDS #
                                   # PTR TO ATTRIB TABLE OF NAME FOUND #
      ITEM CURDIR S:CURRENTDIR;        # FLAG FOR DIRECTIVE BEING      #
                                       # PROCESSED.                    #
      ITEM I,J,K;                      # SCRATCH ITEMS.               # 
      ITEM BEGINBIT,                   # RELATIVE PTRS TO END OF LAST # 
           BEGINWORD;                  # WORD DESCRIBED.              # 
      ITEM BLKLENGTH I;            # NO OF WORDS IN VALUE ARRAY        #
      ITEM COPYWORD I;             # INDEX OF 1ST WORD TO COPY TO      #
      ITEM DEPONFLAG;                  # SET -1 WHEN VARIABLE ARRAY.   #
      ITEM SAVEDEWPOS I;           # SAVE CONTENTS OF DEWPOS[0]        #
      ITEM SAVELENG, SAVELENW;         # FOR SAVING CURLENG AND CURLENW#
      ARRAY [3];                       # FOR SAVING CURWORD.           #
        ITEM SAVE C(,,10);
          BASED ARRAY BSAR; ITEM BSARR I(,,60); 
           BASED ARRAY NAME; ITEM DDATNAME C(0,0,10); 
  
      XREF PROC CHECKFORLFN;       # CHECK FOR AN EXISTING LFN ENTRY   #
      XREF PROC CMOVE;             # CHARACTER MOVE ROUTINE            #
      XREF PROC CONVERT;           # DATA TYPE CONVERSION              #
      XREF PROC DDIAG;             # CALL PROC DIAG WITH DATANAME      #
      XREF PROC DIAG;              # ISSUE DIAGNOSTIC MESSAGE TO USER  #
      XREF PROC LINKNEWLFN;        # LINK NEW LFN ENTRY IN LFNLIST     #
      XREF PROC PICTUR;            # PICTURE CRACKER                   #
      XREF PROC RECNO;
      XREF PROC RECYES; 
      XREF FUNC SAVATTR I;
      XREF PROC SEARCH;            # LOOK FOR DATA NAME ON GIVEN LIST  #
  
  
  
  
#----------------------------------------------------------------------#
  
  
  
  
      XDEF PROC AMBIGNAME;
      PROC AMBIGNAME;                  # SAVE DATANAME UNTIL ITS AMBIG-#
          BEGIN                        # UOUS MEANING IS RESOLVED TO BE#
          RECYES;                  # RETURN TO STDYES IF RECORDING     #
          FOR K=0 STEP 1 UNTIL CURLENW-1 DO # THAT OF A FIELD CONTAIN- #
            SAVE[K] = ICW[K];          # ING AN OCCURRENCE COUNT FOR A #
          SAVELENW = CURLENW;          # VARIABLE-LENGTH ARRAY.        #
          SAVELENG = CURLENG; 
          IF DEPONFLAG LS 0 THEN       # PREVIOUS FIELD WAS DESCRIBED  #
            STDNO;                     # AS VARIABLE-LENGTH AND SHOULD #
                                       # HAVE BEEN THE LAST FIELD.     #
          STDYES; 
          END 
  
  
  
  
#----------------------------------------------------------------------#
  
  
  
  
      XDEF PROC DEPON;
      PROC DEPON;                      # SAVED NAME IS FIELD UPON WHICH#
          BEGIN                        # THE LENGTH OF AN ARRAY DEPENDS#
          RECYES;                  # RETURN TO STDYES IF RECORDING     #
          IF CURDIR EQ S"DESCRIBE" THEN                                 002170
          BEGIN IF DESLIST EQ 0 THEN GOTO RESTORE;                      002180
                K = P<DESATT1>;                                         002190
                P<DESATT1> = DESLIST;                                   002200
          END                                                           002210
          ELSE                                                          002220
          BEGIN IF DEFLIST EQ 0 THEN GOTO RESTORE;                      002230
                K = P<DESATT1>;                                         002240
                P<DESATT1> = DEFLIST;                                   002250
          END                                                           002260
      LOOP:                            # SEARCH DESCRIBE LIST FOR SAVED#
          IF DECNLG[0] EQ SAVELENG AND # NAME.                         #
             DDATNAM[0] EQ SAVE[0] THEN 
             BEGIN
               IF SAVELENW GR 1 THEN
               BEGIN
                 J = SAVELENW - 1;
                 P<NAME> = LOC(DDATNAM[0]); 
      RESTOFNAME: 
                 IF DDATNAME[J] NQ SAVE[J] THEN 
                   GOTO NEXTENTRY;
                 IF J GR 1 THEN 
                 BEGIN
                   J = J - 1; 
                   GOTO RESTOFNAME; 
                 END
               END
          IF DECLASS[0] EQ 0 OR DECLASS[0] GR 5 THEN STDNO; 
          IF DPTLOC[0] NQ 0        # IF SCALED                         #
            AND DECLASS[0] LQ 3    # IF NUM, INTEGER, OR FIXED         #
          THEN
            BEGIN 
            STDNO;                 # INVALID DEPEND ON ITEM            #
            END 
               DEPONFLAG = -P<DESATT1>;# TURN ON DEPENDING-ON FLAG.    #003290
               P<DESATT1> = K;         # RESET TO CURRENT ENTRY.       #003300
               STDYES;
             END
      NEXTENTRY:  
          IF P<DESATT1> NQ K THEN 
          BEGIN 
            P<DESATT1> = DABSPTR[0];  # BUMP TO NEXT ENTRY.            #
            GOTO LOOP;
          END 
      RESTORE:                                                          003390
          FOR K=0 STEP 1 UNTIL SAVELENW-1 DO # RESTORE INTO CURWORD FOR#
            ICW[K] = SAVE[K];          # DIAG.                         #
          CURLENW = SAVELENW; 
          CURLENG = SAVELENG; 
          STDNO;
          END 
  
  
  
  
#----------------------------------------------------------------------#
  
  
  
  
      XDEF PROC DISDATA;
      PROC DISDATA; 
 #
 0        DISDATA - FLAGS ITEMS DEFINED IN DESCRIBE DIRECTIVE AS BEING
                    DISPLAY-CODED ENTITIES WHEN "DISPLAY" ENCOUNTERED 
                    IN FIELD DESCRIPTION. 
 #
          BEGIN 
          RECNO;                   # RETURN STDNO IF RECORDING         #
          DISFLAG = TRUE;          # DISPLAY CODED TYPE                #
          STDNO;                   # NORMAL RETURN                     #
          END 
  
  
  
  
#----------------------------------------------------------------------#
  
  
  
  
      XDEF PROC DN2DEDE;
      PROC DN2DEDE; 
          BEGIN 
          RECYES;                  # RETURN TO STDYES IF RECORDING     #
        IF ICW[0] NQ "FILLER"      # IF AN ACTUAL DATANAME             #
        THEN
          BEGIN 
          P<ANAME2> = LOC(FN[1]);  # PASS DATANAME TO -SEARCH-         #
  
          IF CURDIR EQ S"DESCRIBE" # IF DIRECTIVE IS -DESCRIBE-        #
          THEN
            BEGIN 
                                   # CHECK ONLY ITS OWN DESLIST FOR DUP#
            SEARCH (DESLIST, K, ATTRPTR); 
            END 
          ELSE                     # IF DIRECTIVE IS -DEFINE-          #
            BEGIN 
                                   # CHECK ALL DEFINED ITEMS FOR DUP   #
            SEARCH (DEFLIST, K, ATTRPTR); 
            END 
  
          IF K NQ 0                # IF DUPLICATE FOUND                #
          THEN
            BEGIN 
            STDNO;                 # ERROR EXIT -- DIAGNOSED           #
            END 
                                   # ALSO CHECK SPECIFY LIST FOR DUP   #
          SEARCH (SPELIST, K, ATTRPTR); 
          IF K NQ 0                # IF DUPLICATE FOUND                #
          THEN
            BEGIN 
            STDNO;                 # ERROR EXIT -- DIAGNOSED           #
            END 
  
          END                      # END IF ACTUAL DATANAME            #
  
          IF I GR 1 OR DEPONFLAG LS 0 THEN #REQUEST AN EXTRA WORD#
            K = 1;                     # IF NOT DEFINING OR DESCRIBING #
          ELSE K = 0;                  # AN ELEMENTARY ITEM.           #
          J = CMM$ALF(CURLENW+K+3,0,0);  # REQUEST SPACE FOR ENTRY     #
          IF P<DESATT1> EQ 0 THEN      # IF 1ST ENTRY, THEN SAVE PTR TO#
          BEGIN                        # HEAD OF LIST.                 #
            IF CURDIR EQ S"DESCRIBE" THEN 
              DESLIST = J;
                ELSE SAVEDESC = 0;
          END 
          ELSE                         # ELSE LINK TO PRIOR ENTRY.     #
          BEGIN 
          SAVEDESC = P<DESATT1>;
            IF CURDIR EQ S"DESCRIBE" THEN 
            BEGIN 
         DABSPTR[0] = J;
          IF ORBIT THEN ORBIT = FALSE; ELSE BEGIN 
          IF WITHOCC[0] OR DIMOCC[0] THEN 
          BEGINBIT= BEGINBIT+BEGINWORD*60+DECLSLG[0]*6* 
                  DMAXOCR[0]; 
          ELSE
              BEGINBIT = BEGINBIT + BEGINWORD*60 + DECLSLG[0]*6;
              BEGINWORD =  BEGINBIT/60; 
              BEGINBIT = BEGINBIT - BEGINWORD*60; 
          END 
            END 
          END 
          P<DESATT1> = J; 
          DDWORD0[0] = 0; 
          DDWORD1[0] = 0; 
          DDWORD2[0] = 0; 
          DEPENDS[0] = FALSE; 
          P<NAME> = J + K + 3;
          FOR J=0 STEP 1 UNTIL CURLENW-1 DO # STORE DATANAME IN ENTRY. #
            DDATNAME[J] = ICW[J]; 
          DEWNLG[0] = CURLENW;         # SAVE DATANAME LENGTH IN WORDS #
          DECNLG[0] = CURLENG;         # AND CHARACTERS.               #
          IF I GR 1 THEN               # IF ARRAY SAVE DIMENSION.      #
          BEGIN 
          DMAXOCR[0] = I; 
          DIMOCC[0] = TRUE; 
          WITHOCC[0] = TRUE;
            DFORMAT[0] = 4; 
          END 
          ELSE DFORMAT[0] = 1;
          DECLASS[0] = 4;          # DEFAULT TYPE *FLOATING*           #
          DECLSLG[0] = 10;         # 10 CHARACTER CLASS SIZE           #
          DISFLAG = FALSE;         # NOT *DISPLAY FLOATING*            #
          IF CURDIR EQ S"DESCRIBE" THEN # FOR DESCRIBED ITEMS, STORE   #
          BEGIN                        # THEIR WORD AND BIT POSITIONS, #
            DEWPOS[0] = BEGINWORD;     # AND UPDATE POINTERS TO END OF #
            DBITPOS[0] = BEGINBIT;     # RECORD.                       #
            I = 1;                     # RESET TO ELEMENTARY ITEM.     #
          END 
          IF DEPONFLAG LS 0 THEN                                        001980
          BEGIN DFORMAT[0] = 6;                                         001990
          DEPENDS[0] = TRUE; DIMOCC[0] = TRUE;                          002000
          DOCCPTR[0] = -DEPONFLAG; END                                  002010
          STDYES; 
          END 
  
  
  
  
#----------------------------------------------------------------------#
  
  
  
  
      PROC FREENTRY;
          BEGIN 
          IF DEXPPTR[0] NQ 0 THEN      # FREE ANY EXPRESSION STACK.    #
            CMM$FRF(DEXPPTR[0]);
          IF DCNVTBL[0] NQ 0 THEN      # FREE ANY MOVE/CONVERT TABLE.  #
          BEGIN 
            CMM$FRF(DCNVTBL[0]);
            CMM$FRF(VALULOC[0]);
          END 
          IF MURALPTR NQ 0 THEN    # IF A MURAL EXISTS FOR THIS ENTITY #
            BEGIN 
            CMM$FRF(P<DESATT1> + MURALPTR);  # FREE THE MURAL SPACE    #
            END 
          CMM$FRF(LOC(DESATT1));   # FREE THE ENTRY ITSELF             #
          END 
  
  
  
  
#----------------------------------------------------------------------#
  
  
  
  
      XDEF PROC INIDEF; 
      PROC INIDEF;
          BEGIN #INIDEF#
  
          RECNO;                   # RETURN TO STDNO IF RECORDING      #
          P<DESATT1> = DEFLIST;        # GET HEAD OF DEFINE LIST.      #
          DEPONFLAG = 0;                                                002410
          I = 1;                       # ASSUME ELEMENTARY ITEM.       #
          PROGSTACKLEN = 0;            # ASSUME NO VALUE EXPRESSION.   #
          CURDIR = S"DEFINE"; 
          IF P<DESATT1> EQ 0 THEN 
            STDNO;
      LOOP: 
          IF DABSPTR[0] NQ 0 THEN 
          BEGIN 
            P<DESATT1> = DABSPTR[0];   # FIND LAST ENTRY IN LIST.      #
            GOTO LOOP;
          END 
          STDNO;
          END   #INIDEF#
  
  
  
  
#----------------------------------------------------------------------#
  
  
  
  
      XDEF PROC INIDESC;
      PROC INIDESC; 
          BEGIN                    #INIDESC#
          RECNO;                   # RETURN TO STDNO IF RECORDING      #
          TYPETWD[0] = 0; 
          FSIZE = 0; FL = 0;
          ORBIT = FALSE;
          P<DESATT1> = 0;          # ZERO OUT POINTER IN CASE THERE    #
                                   # WERE PREVIOUS DEFINES OR DESCRIBES#
          DESLIST = 0;
      INIT: 
          I = 1;                       # ASSUME ELEMENTARY ITEM.       #
          CURDIR = S"DESCRIBE"; 
          BEGINBIT = 0;                # INIT PTRS TO END OF RECORD.   #
          BEGINWORD = 0;
          DEPONFLAG = 0;
                                       # TURN OFF DEPENDING-ON FLAG.   #
          STDNO;
          END 
  
  
  
  
#----------------------------------------------------------------------#
  
  
  
  
      XDEF PROC INISPECIFY; 
      PROC INISPECIFY;
          BEGIN 
          RECYES;                  # RETURN TO STDYES IF RECORDING     #
          P<DESATT1> = SPELIST;      # SET TO HEAD OF SPECIFY LIST.  #
          IF P<DESATT1> NQ 0 THEN    # FIND END OF LIST.             #
          BEGIN 
      LOOP: 
            IF DABSPTR[0] NQ 0 THEN 
            BEGIN 
              P<DESATT1> = DABSPTR[0];
              GOTO LOOP;
            END 
          END 
          P<ANAME2> = LOC(FN[1]);  # PASS DATANAME TO -SEARCH-         #
                                   # CHECK FOR DUP AMONG SPECIFY ITEMS #
          SEARCH (SPELIST, K, ATTRPTR); 
          IF K NQ 0                # DIAGNOSE DUPLICATE                #
          THEN
            BEGIN 
            STDNO;
            END 
                                   # ALSO CHECK DEFINE LIST FOR DUPS   #
          SEARCH (DEFLIST, K, ATTRPTR); 
  
          IF K NQ 0                # IF DATANAME WAS DEFINED PREVIOUSLY#
          THEN
            BEGIN 
            STDNO;                 # ERROR EXIT -- DIAGNOSED           #
            END 
  
          P<LFNINFO> = LFNLIST;    # POSITION TO FIRST DESCRIBE LIST   #
          P<DESPTR> = L$DESPTR; 
  
          FOR DUMMY = DUMMY        # FOR EACH EXISTING DESCRIBE LIST   #
            WHILE P<LFNINFO> NQ 0 
          DO
            BEGIN 
                                   # SEARCH FOR DUP ON DESCRIBE LIST   #
            SEARCH (DESADDR, K, ATTRPTR); 
            IF K NQ 0              # IF DUPLICATE FOUND                #
            THEN
              BEGIN 
              STDNO;               # ERROR EXIT -- DIAGNOSED           #
              END 
  
            P<LFNINFO> = L$NEXT;   # POSITION TO NEXT DESCRIBE LIST    #
            P<DESPTR> = L$DESPTR; 
  
            END                    # END -DUMMY- LOOP                  #
          K = CMM$ALF(3+CURLENW,0,0);  # GET SPACE FOR ENTRY IN LIST   #
          IF SPELIST EQ 0 THEN       # SAVE PTR TO 1ST ENTRY IN LIST.#
            SPELIST = K;
          ELSE                       # ELSE LINK TO TAIL OF LIST.    #
            DABSPTR[0] = K; 
          P<DESATT1> = K; 
          CURDIR = S"SPECIFY";         # SET CURRENT DIRECTIVE FLAG.   #
          P<NAME> = P<DESATT1> + 3;    # STORE NAME IN LIST ENTRY.     #
          DDATNAME[0] = ICW[0]; 
          IF CURLENW GR 1 THEN
          BEGIN 
            DDATNAME[1] = ICW[1]; 
            IF CURLENW GR 2 THEN
            BEGIN 
              DDATNAME[2] = ICW[2]; 
              IF CURLENW GR 3 THEN
                DDATNAME[3] = ICW[3]; 
            END 
          END 
          DEWNLG[0] = CURLENW;
          DECNLG[0] = CURLENG;
          DECLASS[0] = 7;              # CLASS IS LOGICAL.             #
          DPICSIZ[0] = 1; 
          STDYES; 
          END 
  
  
  
  
#----------------------------------------------------------------------#
  
  
  
  
      XDEF PROC INTDEDE;
      PROC INTDEDE; 
          BEGIN 
          I = ICWI[5];                 # SAVE NR ENTRIES IN ARRAY.     #
          IF I GR 0                # IF VALID NUMBER OF ENTRIES        #
            AND I LS 4096          # UPPER BOUND FIELD IS 12 BITS LONG #
          THEN
            BEGIN 
            STDYES; 
            END 
          STDNO;
          END 
  
  
  
  
#----------------------------------------------------------------------#
  
  
  
  
      XDEF PROC LINKDESLFN; 
      PROC LINKDESLFN;
      BEGIN 
      ITEM EC;
          RECNO;                   # RETURN TO STDNO  IF RECORDING     #
      CHECKFORLFN;        # SEE IF LFN ALREADY EXISTS.  RELEASE SPACE, #
      EC = 0;             # ETC., IF SO.                               #
      LINKNEWLFN (EC);    # LINK NEW LFN INTO LFN LIST.                #
      P<LFNINFO> = CURRENTLFPTR;
      STDNO;
      END 
  
  
  
  
#----------------------------------------------------------------------#
  
  
  
  
          XDEF PROC NEXTARR;
          PROC NEXTARR; 
          BEGIN 
          ARRAY CONVPARAMS [0] S(2);
            ITEM EDIT B(0,3,1) = [FALSE], 
                 FROMCHAR U(0,4,4), 
                 TOCHAR U(0,8,4), 
                 NBCHAR U(0,12,12),  # LENGTH OF FIELD IN CHARACTERS   #
                 FROMWORD I(0,24,18), 
                 TOWORD   I(0,42,18), 
                 CONVERTCODE U(1,0,6),
                 FROMPTR I(1,24,18) = [0],
                 TOPTR   I(1,42,18);
          RECYES;                  # RETURN TO STDYES IF RECORDING     #
          IF FIGLITDATA NQ S"LITERAL"  # IF NOT LITERAL                #
          THEN
            BEGIN 
            STDNO;
            END 
  
          IF J GR I                # IF HAVE ALREADY PRESET WHOLE ARRAY#
          THEN
            BEGIN 
            STDNO;                 # ERROR RETURN - TOO MANY PRESETS   #
            END 
  
                IF DATATYPE NQ DECLASS[0]  # DIFFERENT TYPES OF DATA   #
                  OR (DECLASS EQ 2         # SCALED INTEGER            #
                    AND DPTLOC NQ 0)
                THEN
                BEGIN 
                  FROMWORD[0] = DATAWORDADDR; 
                  NBCHAR[0] = DATALENG; 
                  K = DECLASS[0]; 
                  CONVERTCODE[0] = B<K*6,6>CCODE[DATATYPE]; 
                TOWORD[0] = BEGINWORD;
                TOCHAR[0] = BEGINBIT; 
                TOPTR[0] = LOC(SAVELENW); 
                IF DATATYPE EQ 2   # IF CONVERTING FROM INTEGER        #
                THEN
                  BEGIN 
                  ATTRWP[0] = DATAWORDADDR;  # STORE ADD IN ATTRIB TABL#
                  FROMWORD[0] = LOC(ATTRIB) - 1;  # STORE ATTRIB ADDRSS#
                                                  # IN CONVERT PARAM   #
                  END 
                IF DECLASS[0] LQ 2             # IF CHAR, NUMERIC, INT #
                  AND CONVERTCODE[0] NQ O"10"  # NOT CHAR TO LOGICAL   #
                THEN
                  BEGIN 
                  SAVEDEWPOS = DEWPOS;  #STARTING WORD POSITION ITEM(1)#
                  DEWPOS = BEGINWORD + SAVELENW;  # STARTING WORD POS  #
                                                  # OF ITEM(N)         #
                  DBITPOS = BEGINBIT * 6;  # STARTING BIT POS ITEM(N)  #
                  TOWORD = P<DESATT1>;  # ATTRIBUTE POINTER            #
                  TOPTR = 0;
                  END 
                CONVERT(CONVPARAMS,K);
                IF DECLASS[0] LQ 2             # IF CHAR, NUMERIC, INT #
                  AND CONVERTCODE[0] NQ O"10"  # NOT CHAR TO LOGICAL   #
                THEN
                  BEGIN 
                  DEWPOS = SAVEDEWPOS;  #STARTING WORD POSITION ITEM(1)#
                  DBITPOS = 0;     # STARTING BIT POSITION ITEM(1)     #
                  END 
                IF K NQ 0 THEN DIAG(K); 
                CMM$FRF(DATAWORDADDR);
            END 
            ELSE
            BEGIN 
                IF DATATYPE EQ 0 THEN 
                BEGIN IF DATALENG GR SAVELENG THEN K = SAVELENG;
                      ELSE K = DATALENG;
                END 
                P<MOVETABLE> = DATAWORDADDR;
                P<DESATT2> = SAVELENW + BEGINWORD;
                CMOVE(MOVETABLE,0,K,DESATT2,BEGINBIT);
            END 
            BEGINBIT = BEGINBIT + SAVELENG; 
            K = BEGINBIT / 10;
            BEGINBIT = BEGINBIT - K * 10; 
            BEGINWORD = BEGINWORD + K;
            J = J + 1;
          K = SAVELENG; 
          STDYES; 
          END 
  
  
  
  
#----------------------------------------------------------------------#
  
  
  
  
      XDEF PROC PICDEDE;
      PROC PICDEDE;          BEGIN
      ITEM IK;                     # LOOP COUNTER                      #
          RECYES;                  # RETURN TO STDYES IF RECORDING     #
  
           PICTUR(DESATT1); 
          # TEST TO SEE THAT THE SIZE OF THE PICTURE FOR NUMERIC       #000341
          # ITEMS DOES NOT EXCEED THE MAXIMUM ALLOWED (18)             #000342
          IF CURDIR EQ S"DEFINE"   # TEST APPLIES ONLY FOR DEF         #000350
            AND DECLASS[0] GQ 1    # CHECK ONLY NUMERIC ITEMS          #000360
              AND DECLASS[0] LS 7                                       000380
          THEN                                                          000390
          BEGIN                                                         000400
            IF (EXTCOUNT[0] - INSERTS[0]) GR 18    # DIGITS VS MAX     #000410
            THEN                                                        000420
            BEGIN                                                       000430
              DPICSIZ[0] = 0;      # USE DEFAULT AS IF NO PICTURE      #000440
              DIAG(335);           # WARN USER OF CHANGE               #000450
              STDYES;                                                   000460
              END                                                       000470
            END                                                         000480
          IF DECLASS[0] EQ 1 THEN 
            BEGIN 
            IF PICSIGN NQ 0        # IF CR,DB,+,- IN PICTURE           #
              OR SIGNFLAG NQ 0     # IF S IN PICTURE                   #
            THEN                   # IF ONE OF ABOVE FOUND...          #
              BEGIN 
              DOVERPUN[0] = TRUE;  # THIS WILL CAUSE CONVERT TO        #
                                   # COMPLEMENT A NEGATIVE NUMERIC     #
                                   # NUMBER BEFORE PASSING IT TO       #
                                   # NUMERED SO THAT SIGN EDITING WILL #
                                   # BE DONE CORRECTLY.                #
              END 
            END 
          IF DECLASS[0] EQ 0 OR        # IN SOME CASES, THE PICTURE    #003430
             DECLASS[0] EQ 1 OR        # DESCRIBES THE INTERNAL SIZE OF#003440
             DECLASS[0] GQ 8 THEN      # A FIELD.                      #003450
          DECLSLG[0] = EXTCOUNT[0] - INSERTS[0];
          IF CURDIR EQ S"DESCRIBE" THEN BEGIN 
          IF DIMOCC[0] OR WITHOCC[0] THEN 
          BEGIN 
                FL = FL+DECLSLG[0]*DMAXOCR[0];
          END 
          ELSE FL = FL + DECLSLG[0];
          IF FL GR FSIZE THEN FSIZE = FL; 
            END 
          DISPLAYSIZE[0] = EXTCOUNT[0] - INSERTS[0];                    003470
          IF DECLASS[0] EQ 6 THEN      # PICTURE FOR COMPLEX IS USED   #003480
            DPICSIZ[0] = EXTCOUNT[0]*2+1;# FOR BOTH REAL AND IMAGINARY.#003490
          ELSE DPICSIZ[0] = EXTCOUNT[0];                                003500
          IF PTLOC[0] NQ 0 THEN                                         003510
          BEGIN                                                         003520
            DPTLOC[0] = B<55,5>PTLOC[0];                                003530
            IF B<53>PTLOC[0] EQ 1 THEN                                  003540
              DPOINT[0] = TRUE;                                         003550
            IF B<54>PTLOC[0] EQ 1 THEN                                  003560
              DPTLOC[0] = -DPTLOC[0];                                   003570
          END                                                           003580
          IF MURLENG NQ 0 THEN     # IF A MURAL EXISTS FOR THIS ENTITY #
            BEGIN 
            P<MR> = CMM$ALF(MURLENG, 0, 0);  # ALLOCATE SPACE FOR MURAL#
            MURALPTR = P<MR> - P<DESATT1>;   # STORE REL PTR TO MURAL  #
            FOR IK = 0 STEP 1 UNTIL MURLENG-1 DO  # FOR EACH MURAL WORD#
              BEGIN 
              MURL[IK] = PIC[IK];  # SAVE THIS WORD OF THE MURAL       #
              END 
            END 
          STDYES; 
          END  #END OF PICDEDE# 
  
  
  
  
#----------------------------------------------------------------------#
  
  
  
  
          XDEF PROC RESTARR;
          PROC RESTARR; 
          BEGIN 
          RECNO;                   # RETURN TO STDNO IF RECORDING      #
             IF SAVEDESC NQ 0 THEN BEGIN
          K = P<DESATT1>; 
          P<DESATT1> == SAVEDESC; 
          DABSPTR[0] = K; 
          P<DESATT1> = SAVEDESC;
                  END ELSE DEFLIST = P<DESATT1>;
      IF J LQ I                    # IF MORE VALUES TO PRESET          #
      THEN
        BEGIN 
        P<DESATT2> = SAVELENW;     # POSITION TO VALUE ARRAY           #
        IF DECLASS[0] LQ 1         # IF CHAR OR NUM                    #
        THEN
          BEGIN 
          BEGINBIT = BEGINWORD * 10 + BEGINBIT;  # CHAR POS OF NEXT    #
                                                 # CHAR TO PRESET      #
          SAVELENW = BEGINBIT - SAVELENG;  # CHAR POS OF LAST VALUE    #
                                           # PRESET                    #
          BEGINWORD = SAVELENW / 10;  # WORD POSITION OF LAST VALUE SET#
          K = J + 8;               # GO THROUGH LOOP AT MOST 9 TIMES   #
          IF K GR I 
          THEN
            BEGIN 
            K = I;
            END 
          FOR J = J STEP 1
            UNTIL K 
          DO
            BEGIN 
            CMOVE(DESATT2,SAVELENW,SAVELENG,DESATT2,BEGINBIT);
            BEGINBIT = BEGINBIT + SAVELENG; 
            END 
          IF J GQ I                # IF NO MORE VALUES TO PRESET       #
          THEN
            BEGIN 
            STDNO;
            END 
          COPYWORD = BEGINBIT / 10;  # WORD POS OF NEXT VALUE          #
          K = BEGINBIT - COPYWORD * 10;  # CHAR POS OF NEXT CHAR       #
          IF K NQ 0                # IF NOT ON WORD BOUNDARY           #
          THEN
            BEGIN 
            CMOVE(DESATT2, SAVELENW, 10 - K, DESATT2, BEGINBIT);
            COPYWORD = COPYWORD + 1;
            BEGINWORD = BEGINWORD + 1;
            END 
          END 
        ELSE
          BEGIN 
          COPYWORD = BEGINWORD; 
          IF DECLASS[0] EQ 5       # IF DOUBLE                         #
            OR DECLASS[0] EQ 6     # IF COMPLEX                        #
          THEN
            BEGIN 
            IF DEDMUR[BEGINWORD - 2] EQ 0 
              AND DEDMUR[BEGINWORD - 1] EQ 0  # IF PRESET IS ZERO      #
            THEN
              BEGIN 
              STDNO;
              END 
            BEGINWORD = BEGINWORD - 2;
            END 
          ELSE                     # IF INT, FIXED, FL, OR LOGICAL     #
            BEGIN 
            IF DEDMUR[BEGINWORD - 1] EQ 0  # IF PRESET IS ZERO         #
            THEN
              BEGIN 
              STDNO;
              END 
            BEGINWORD = BEGINWORD - 1;
            END 
          END 
        FOR K = 0 STEP 1           # PRESET REST OF ARRAY BY COPYING   #
                                   # FROM ONE BLOCK WHOSE LENGTH IS    #
                                   # 10 * LENGTH OF ONE VALUE TO       #
                                   # BLOCK IMMEDIATELY FOLLOWING       #
                                   # FIRST BLOCK                       #
          WHILE COPYWORD + K LQ BLKLENGTH - 1 
        DO
          BEGIN 
          DEDMUR[COPYWORD + K] = DEDMUR[BEGINWORD + K]; 
          END 
        END 
              STDNO;
          END 
  
  
  
  
#----------------------------------------------------------------------#
  
  
  
  
      XDEF PROC RETENTRY; 
      PROC RETENTRY;                   # RETURNS THE LIST ENTRY BEING  #
          BEGIN                        # BUILT AFTER ERROR OCCURRENCE. #
          RECNO;                   # RETURN TO STDNO IF RECORDING      #
          K = P<DESATT1>; 
          IF CURDIR EQ S"DEFINE" THEN 
         BEGIN IF SAVEDESC NQ 0 THEN
               BEGIN P<DESATT1> = SAVEDESC; 
                     DABSPTR[0] = K;
                     P<DESATT1> = K;
               END
               ELSE DEFLIST = K;
            IF DEFLIST EQ K THEN
            BEGIN 
              DEFLIST = 0;
              GOTO RETURNENTRY; 
            END 
            ELSE P<DESATT1> = DEFLIST;
        END 
          ELSE
            IF SPELIST EQ K THEN       # CHECK IF CURRENTLY BUILDING   #
            BEGIN                      # 1ST ENTRY IN THE SPECIFY LIST.#
              SPELIST = 0;
              GOTO RETURNENTRY; 
            END 
            ELSE P<DESATT1> = SPELIST;
      LOOP: 
          IF DABSPTR[0] NQ K THEN 
          BEGIN 
            P<DESATT1> = DABSPTR[0];
            GOTO LOOP;
          END 
          DABSPTR[0] = 0;              # DE-LINK ENTRY FROM END OF LIST#
          P<DESATT1> = K; 
      RETURNENTRY:  
          FREENTRY; 
          STDNO;
          END 
  
  
  
  
#----------------------------------------------------------------------#
  
  
  
  
          XDEF PROC RSETDES;
          PROC RSETDES; 
          BEGIN I = 1;
          FL = 0; 
          ORBIT = TRUE; 
                 BEGINBIT = 0;
                 BEGINWORD = 0; 
                 DEPONFLAG = 0; 
                 STDNO; 
          END 
  
  
  
  
#----------------------------------------------------------------------#
  
  
  
  
      XDEF PROC TYPDEDE;
      PROC TYPDEDE; 
          BEGIN 
          RECYES;                  # RETURN TO STDYES IF RECORDING     #
          J = CP1A[0];
          DECLSLG[0] = SIZE[J] * 10;
          IF DISFLAG               # IF *DISPLAY* <TYPE>               #
          THEN
            BEGIN 
            IF J EQ 2 THEN             # "DISPLAY INTEGER" CLASS CODE  #
              J = 1;                   # SET TO "DISPLAY NUMERIC" CLASS#
            IF J GQ 3 THEN             # BIAS CLASS CODE TO INDICATE   #
              J = J + 8;               # DISPLAY-CODED DATA.           #
            END 
  
          DECLASS[0] = J;              # STORE CODE IN ATTRIBUTE ENTRY.#
          IF CURDIR EQ S"DESCRIBE"  # IF DESCRIBE DIRECTIVE            #
          THEN
            BEGIN 
            IF DBITPOS[0] NQ 0     # IF NOT WORD ALIGNED               #
              AND J GQ 2           # IF INTEGER, FIXED, FLOAT, DOUBLE, #
              AND J LQ 7           # COMPLEX, OR LOGICAL AND DISPLAY   #
                                   # OPTION OMITTED                    #
            THEN
              BEGIN 
              DDIAG(366);          # <DATANAME> MUST BE WORD ALIGNED   #
              STDNO;               # ERROR EXIT                        #
              END 
            END 
          STDYES; 
          END 
  
  
  
  
#----------------------------------------------------------------------#
  
  
  
  
      XDEF PROC XEQDEF; 
      PROC XEQDEF;
          BEGIN 
          ARRAY CONVPARAMS [0] S(2);
            ITEM EDIT B(0,3,1) = [FALSE], 
                 FROMCHAR U(0,4,4), 
                 TOCHAR U(0,8,4), 
                 NBCHAR U(0,12,12),  # LENGTH OF FIELD IN CHARACTERS   #
                 FROMWORD I(0,24,18), 
                 TOWORD   I(0,42,18), 
                 CONVERTCODE U(1,0,6),
                 FROMPTR I(1,24,18) = [0],
                 TOPTR   I(1,42,18);
          RECYES;                  # RETURN TO STDYES IF RECORDING     #
          IF PROGSTACKLEN NQ 0 THEN    # IF DEF INCLUDES VALUE EXPRESS,#
          BEGIN 
            IF DECLSLG EQ 0        # IF CHARACTER OR NUMERIC ITEM...   #
                                   # AND NO PICTURE SPECIFIED          #
            THEN
              BEGIN 
              DECLSLG = DISPSIZ[DECLASS];  # DEFAULT STORAGE/PIC SIZE  #
              END 
            IF PROGSTACKLEN GR 0 THEN  # STORE PTR TO STACK AND RESULT #
            BEGIN                      # TYPE.                         #
          IF I GR 1 THEN     #PRESET ARRAY WITH EXPRESSION# 
          BEGIN DIAG(201); RETENTRY;
          END 
              DEXPPTR[0] = PROGSTACKLOC;
              IF DFORMAT[0] NQ 1 OR    # IF ARRAY OR VALUE IS OTHER    #
                 RESULTUSAGE NQ DECLASS[0] OR # USAGE OR THE TWO SIZES #
                 (DECLASS[0] EQ 2     # IF SCALED INTEGER              #
                   AND DPTLOC[0] NQ 0 ) OR
                 DATALENG NQ DECLSLG[0] THEN # DIFFER THEN BUILD       #
              BEGIN                    # A MOVE/CONVERT TABLE.         #
                P<MOVETABLE> = CMM$ALF(EESIZE, 0, 0); 
                PRKEY[0] = AKEYITEM;
                MKEYEXCL[0] = EXCLKEYITEM;
                MITEMORD = DATAITEMORD; 
                MRECDORD = DATARECDORD; 
                DCNVTBL[0] = P<MOVETABLE>;
                K = SIZE[DECLASS[0]] * 10;
                IF K EQ 0          # IF ALPHANUMERIC OR NUMERIC        #
                THEN
                  BEGIN 
                  NBRCHARS[0] = DECLSLG[0]; 
                  K = DECLSLG[0]; 
                  END 
                ELSE
                  BEGIN 
                  NBRCHARS[0] = K;
                  END 
                BLKLENGTH = (K * I + 9) / 10; 
                IF DECLASS[0] EQ 0 # IF CHARACTER                      #
                THEN
                  BEGIN 
                  CMM$PRS = O"55555555555555555555";
                  END 
                IF DECLASS[0] EQ 1 # IF NUMERIC                        #
                THEN
                  BEGIN 
                  CMM$PRS = O"33333333333333333333";
                  END 
                VALULOC[0] = CMM$ALF(BLKLENGTH, 0, 0);
                FBASE[0] = RESULTSLOC;  # STORE BASE ADDRESS           #
  
                IF RESULTUSAGE GQ 1  # IF INTEGER, NUMERIC OR FIXED    #
                  AND RESULTUSAGE LQ 3
                THEN
                  BEGIN 
                  P<ADDR> = CMM$ALF(2, 0, SM$GROUPID);  # ALLOC TABLE  #
                  ADDRLG[0] = DATALENG;  # STORE LENGTH                #
                  FWORD[0] = P<ADDR> - 1;  # SET FROM ADDR FOR CONVERT #
                  END 
  
                K = DECLASS[0]; 
                IF K NQ RESULTUSAGE OR
                   (K EQ 2         # IF SCALED INTEGER                 #
                     AND DPTLOC[0] NQ 0) OR 
                   K LQ 1 THEN
                BEGIN 
                  CONCODE[0] = B<K*6,6>CCODE[RESULTUSAGE];
                  ENTRYCODE[0] = 3; 
                  IF K EQ 0 THEN
                  BEGIN 
                    NBRCHARS[0] = DATALENG; 
                  END 
                   IF K LQ 2       # IF CHARACTER, NUMERIC, OR INTEGER #
                  THEN
                    BEGIN 
                    TWORD[0] = P<DESATT1>;  # ATTRIBUTE POINTER        #
                    END 
                  ELSE TWORD[0] = VALULOC[0]; 
                END 
                ELSE
                BEGIN 
                  ENTRYCODE[0] = 1; 
                  TWORD[0] = VALULOC[0];
                END 
              END 
              ELSE VALULOC[0] = RESULTSLOC; 
            END 
            ELSE                       # IF VALUE IS SIMPLE DATANAME,  #
            BEGIN                      # BUILD MOVE TABLE AND STORE PTR#
              IF FIGLITDATA EQ S"LITERAL" THEN # IN ENTRY, CONVERTING  #
              BEGIN                    # IF NECESSARY.                 #
              IF DATATYPE NQ DECLASS[0]  # IF DIFFERENT TYPES OF DATA  #
                OR (DECLASS[0] EQ 2      # IF SCALED INTEGER           #
                  AND DPTLOC[0] NQ 0) 
              THEN
                BEGIN 
                  FROMWORD[0] = DATAWORDADDR; 
                  NBCHAR[0] = DATALENG; 
                  K = DECLASS[0]; 
                  CONVERTCODE[0] = B<K*6,6>CCODE[DATATYPE]; 
                IF I GR 1 OR           # IF ARRAY DEFINITION OR        #
                   K LQ 2 OR           # IF CHAR, NUMERIC, OR INTEGER  #
                   K EQ 5              # CLASS IS DOUBLE               # QU3A348
                   OR K EQ 6           # CLASS IS COMPLEX              # QU3A348
                   THEN                                                  QU3A348
                   BEGIN               # EXTRA SPACE.                  #
                     BLKLENGTH = (DECLSLG[0] * I + 9) / 10; 
                     J = CMM$ALF(BLKLENGTH, 0, 0);
                     IF K LQ 2     # IF CHAR, NUMERIC, OR INTEGER      #
                     THEN 
                       TOWORD[0] = P<DESATT1>;
                     ELSE TOWORD[0] = J;
                     VALULOC[0] = J;
                   END
         ELSE BEGIN 
              TOWORD[0] = DATAWORDADDR; 
              VALULOC[0] = DATAWORDADDR;
              END 
                     IF DATATYPE EQ 2  # IF CONVERTING FROM INTEGER    #
                     THEN 
                       BEGIN
                       ATTRWP[0] = DATAWORDADDR;  # ADDRESS IN ATTRIB  #
                       FROMWORD[0] = LOC(ATTRIB) - 1;  # ATTRIB ADD IN #
                                                       # CONVERT PARAM #
                       END
                  IF DATATYPE EQ 0 # IF SOURCE IS CHARATER             # QU3A094
                    AND CONVERTCODE[0] NQ O"10"  # NOT CHAR TO LOGICAL # QU3A094
                  THEN             # CHANGE CALLING SEQUENCE           # QU3A094
                    BEGIN                                                QU3A094
                    TOWORD[0] = P<DESATT1>;  # ATTRIBUTE FOR CONVERT   # QU3A094
                    END                                                  QU3A094
                  CONVERT(CONVPARAMS,K);# CONVERT TO PROPER TYPE       #
                  IF K NQ 0 THEN      # ALL WE CAN DO IS DIAGNOSE THE  #
                    DIAG(K);           # ERROR AND HOPE IT IS RETRANS.# 
                  IF VALULOC NQ DATAWORDADDR  # IF NEW VALUE LOCATION  # QU3A094
                  THEN             # THEN RETURN OLD                   # QU3A094
                    CMM$FRF (DATAWORDADDR); 
                END 
                ELSE
                BEGIN 
                  IF DATATYPE LS 2 AND # IF CHAR LIT " FIELD SIZE HAVE #
                     DECLSLG[0] NQ DATALENG THEN # TO CHANGE LIT SIZE. #
                  BEGIN 
      MOVELIT:  
                    K = DECLSLG[0]; 
                    BLKLENGTH = (K * I + 9) / 10; 
                    IF DECLASS[0] EQ 0
                    THEN
                      BEGIN 
                      CMM$PRS = O"55555555555555555555";
                      END 
                    IF DECLASS[0] EQ 1
                    THEN
                      BEGIN 
                      CMM$PRS = O"33333333333333333333";
                      END 
                    P<DESATT2> = CMM$ALF(BLKLENGTH, 0, 0);
                    VALULOC[0] = P<DESATT2>;
                    J = ((K + 9) / 10) - 1; 
                    K = ((DECLSLG[0] + 9) /10) - 1; 
          J = (DATALENG - 1) / 10;
          IF J LS K THEN K = J; #MOVE SMALLER SIZE# 
                    J = P<DESATT1>;    # SAVE ENTRY LOCATION.          #
                    P<DESATT1> = DATAWORDADDR;
                    FOR I=0 STEP 1 UNTIL K DO # MOVE LITERAL TO CHANGE #
                      DEDMUR[I] = DDWORD0[I]; # SIZE.                  #
                    P<DESATT1> = J;    # RESET TO ENTRY LOCATION.      #
                    CMM$FRF (DATAWORDADDR); 
                  END 
                  ELSE IF I GR 1 THEN  # IF ARRAY DEF, THEN HAVE TO    #
                         GOTO MOVELIT; # MOVE LITERAL TO ARRAY SPACE.  #
                       ELSE VALULOC[0] = DATAWORDADDR;
                END 
              END 
              ELSE
              BEGIN 
          IF I GR 1 THEN BEGIN DIAG(201); RETENTRY; 
          END 
                                   # BUILD EXECUTION TIME MOVE TABLE   #
                P<MOVETABLE> = CMM$ALF(EESIZE, 0, 0); 
                PRKEY[0] = AKEYITEM;
                MKEYEXCL[0] = EXCLKEYITEM;
                MITEMORD = DATAITEMORD; 
                MRECDORD = DATARECDORD; 
                DCNVTBL[0] = P<MOVETABLE>;
                FCHAR[0] = DATACHARPOS; 
                FBASE[0] = DATANAMEBASE;
                NBRCHARS[0] = DATALENG; 
                K = SIZE[DECLASS[0]] * 10;
                IF K EQ 0 
                THEN
                  BEGIN 
                  K = DECLSLG[0]; 
                  END 
                BLKLENGTH = (K * I + 9) / 10; 
                IF DECLASS[0] EQ 0 # IF CHARACTER                      #
                THEN
                  BEGIN 
                  CMM$PRS = O"55555555555555555555";
                  END 
                IF DECLASS[0] EQ 1 # IF NUMERIC                        #
                THEN
                  BEGIN 
                  CMM$PRS = O"33333333333333333333";
                  END 
                VALULOC[0] = CMM$ALF(BLKLENGTH, 0, 0);
                K = DECLASS[0]; 
                IF AREAITM
                THEN
                  BEGIN 
                  P<DESATT3> = LOC(DIRECTENTRY);
                  END 
                ELSE
                  BEGIN 
                  P<DESATT3> = DATANAMEPTR; 
                  END 
                IF K NQ DATANAMEUSE OR  # MAKE CONVERT ENTRIES IN TABLE#
                     (K LQ 1                   # CHARACTER OR NUMERIC  #
                     AND DATALENG NQ DECLSLG)  # DIFFERENT LENGTHS     #
                   OR (K EQ 2                  # INTEGER               #
                     AND DPTLOC NQ DPTLOC3)    # DIFFERENT SCALING     #
                   OR (K EQ 4                  # FLOAT TO FLOAT        #
                     AND DATANAMEUSE EQ 4)     # (E) FORMAT            #
                   OR (K EQ 5                  # DOUBLE TO DOUBLE      #
                     AND DATANAMEUSE EQ 5)     # (D) FORMAT            #
                THEN
                BEGIN 
                  J = B<K*6,6>CCODE[DATATYPE];
                  IF J LS O"10" AND 
                     J NQ 1 THEN
                  BEGIN 
          IF DIMOCC[0] THEN J = 1; ELSE J = 0;
      C<0,10>K = DDATNAM[J];
      DDATNAM[J] = ICW[0];
      ICW[0] = C<0,10>K;
      K = DECNLG[J];
      DECNLG[J] = CURLENG;
      CURLENG = K;
          DIAG(169);
      C<0,10>K = DDATNAM[J];
      DDATNAM[J] = ICW[0];
      ICW[0] = C<0,10>K;
      K = DECNLG[J];
      DECNLG[J] = CURLENG;
      CURLENG = K;
                    STDNO;
                  END 
                  CONCODE[0] = J;      # STORE CONVERSION REQUEST CODE.#
                  IF DATATYPE EQ 1 # IF SOURCE IS NUMERIC              #
                    AND DECLASS[0] NQ 1  # IF DEFINED ITEM NOT NUMERIC #
                  THEN
                    BEGIN 
                    MEDIT[0] = TRUE;  # EDITING REQUIRED               #
                    END 
                  ENTRYCODE[0] = 2; 
                  IF K LQ 2        # IF CHARACTER, NUMERIC, OR INTEGER #
                  THEN
                    TWORD[0] = P<DESATT1>;
                  ELSE TWORD[0] = VALULOC[0]; 
          IF DATATYPE GQ 1         # IF NUMERIC, INTEGER, OR UNNORM    #
            AND DATATYPE LQ 3 
          THEN
          BEGIN IF AREAITM THEN DATANAMEPTR = SAVATTR;
                       FWORD[0] = DATANAMEPTR;
          END 
                  ELSE FWORD[0] = DATAWORDADDR; 
                END 
                ELSE
                BEGIN 
                  ENTRYCODE[0] = 1;  # ELSE JUST MOVE PARAMS IN TABLE.# 
                  TWORD[0] = VALULOC[0];
                  FWORD[0] = DATAWORDADDR;
                END 
              IF INDICED           # IF VALUE IS SUBSCRIPTED           #
              THEN
                BEGIN 
                P<INDTBL> = INDCTBLOC;  # POSITION TO INDEX TABLE      #
                IF FWORD[0] EQ DATANAMEPTR  # IF USING ATTRIB TABLE    #
                  OR AREAITM       # IF AREA ITEM                      #
                  OR INDFG NQ 0    # IF NOT A CONSTANT SUBSCRIPT       #
                THEN
                  BEGIN 
                  STACKADD[0] = P<INDTBL>;  # SAVE PTR TO INDEX TABLE  #
                  ENTRYCODE[0] = 4;  # TELL EVALUATE TO CALL FIGSUB    #
                  IF AREAITM       # IF AREA ITEM                      #
                  THEN
                    BEGIN 
                    DATANAMEPTR = SAVATTR;  # SAVE ATTRIB TABLE IF NOT #
                                            # ALREADY SAVED            #
                    END 
  
                  FWORD[0] = DATANAMEPTR;  # FROM ADDRESS = ATTRIB     #
                                           # TABLE ADDRESS             #
                  END 
                END 
              END 
            END 
          END 
          ELSE
          BEGIN 
            K = SIZE[DECLASS[0]] * 10;
            IF K LQ 10
            THEN
              BEGIN 
              IF DECLSLG[0] EQ 0
              THEN
                BEGIN 
                K = DISPSIZ[DECLASS];  # DEFAULT STORAGE/PICTURE SIZE  #
                END 
              ELSE
                BEGIN 
                K = DECLSLG[0]; 
                END 
              END 
            IF DECLSLG[0] EQ 0
            THEN
              BEGIN 
              DECLSLG[0] = K; 
              END 
            BLKLENGTH = (K * I + 9) / 10; 
            IF DECLASS[0] EQ 0
            THEN
              BEGIN 
              CMM$PRS = O"55555555555555555555";
              END 
            IF DECLASS[0] EQ 1
            THEN
              BEGIN 
              CMM$PRS = O"33333333333333333333";
              END 
            VALULOC[0] = CMM$ALF(BLKLENGTH, 0, 0);
          END 
          IF DPICSIZ[0] EQ 0 THEN      # IF NO PICTURE, ENTER DEFAULTED#
            BEGIN 
            DPICSIZ[0] = PICSIZ[DECLASS[0]];# SIZE LESS EDITING CHARS. #003340
            DISPLAYSIZE[0] = DISPSIZ[DECLASS[0]];                       003350
            IF DECLASS[0] EQ 1     # IF NUMERIC                        #
            THEN
              BEGIN 
              DOVERPUN[0] = TRUE;  # DEFAULT PIC CONTAINS -            #
              END 
            DPTLOC[0] = DECPT[DECLASS[0]];                              003360
          IF DEFMURAL[DECLASS[0]] NQ 0  # IF MURAL REQUIRED            #
          THEN
            BEGIN 
            P<MR> = CMM$ALF(1,0,0);  # ALLOCATE SPACE FOR MURAL        #
            MURALPTR = P<MR> - P<DESATT1>;  # STORE REL PTR TO MURAL   #
            MURL[0] = DEFMURAL[DECLASS[0]];  # STORE DEFAULT MURAL     #
            END 
          END                                                           003370
           I = 0; 
          IF DFORMAT[0] NQ 1 AND CURDIR EQ S"DEFINE"   THEN 
          BEGIN 
                I = DMAXOCR[0]; 
                J = 2;
              K = DECLSLG[0];  #CHARPOS#
                SAVELENG = K; 
                BEGINWORD = K / 10; 
                BEGINBIT = K - BEGINWORD * 10;
                SAVELENW = VALULOC[0];
               STDYES;
          END 
             IF SAVEDESC NQ 0 THEN BEGIN
          K = P<DESATT1>; 
          P<DESATT1> = SAVEDESC;
          DABSPTR[0] = K; 
                  END ELSE DEFLIST = P<DESATT1>;
          STDNO;
          END 
  
  
  
  
#----------------------------------------------------------------------#
  
  
  
  
      XDEF PROC XEQSPECIFY; 
      PROC XEQSPECIFY;
          BEGIN 
          RECYES;                  # RETURN TO STDYES IF RECORDING     #
          IF PROGSTACKLEN LQ 0 THEN    # CONDITIONAL EXPRESSION MUST   #
            STDNO;                     # HAVE BEEN GIVEN, DIAG IF NONE.#
          DEXPPTR[0] = PROGSTACKLOC;   # STORE PTR TO EXPRESSION STACK.#
          VALULOC[0] = RESULTSLOC;     # STORE PTR TO RESULT OF EXPRESS#
           IF AREAITM THEN DPOINT[0]=TRUE; #USE DPOINT AS A FLAG TO SEE 
                     WHETHER SPECIFY INVOLVES AREAITM OR NOT# 
          IF DESITM                # IF DESCRIBE ITEMS FOUND IN SPECIFY#
                                   # EXPRESSION, USE DESCON AS A FLAG  #
                                   # TO INDICATE THIS FACT.            #
          THEN
            BEGIN 
            DESCON[0] = TRUE; 
            END 
          STDYES; 
          END 
  
  
  
  
#----------------------------------------------------------------------#
  
  
      END 
      TERM
