*DECK DISPLAY 
USETEXT TBASCTB 
USETEXT TCLFN 
USETEXT TCMMDEF 
USETEXT TCONVRT 
USETEXT TDESATT 
USETEXT TDTABLE 
USETEXT TENVIRN 
USETEXT TEXPRES 
USETEXT TINDTBL 
USETEXT TLFNINF 
USETEXT TOPTION 
USETEXT TSBASIC 
USETEXT TXSTD 
      PROC DISPLAY; 
  
#----------------------------------------------------------------------#
#                                                                      #
#  THE FOLLOWING PROCS ARE XDEF"D WITHIN THIS DECK:                    #
#                                                                      #
#     DISPEND                      ENDING OF DISPLY SEMANTICS          #
#     DISPTBL                      BUILD A DISPLAY TABLE ENTRY         #
#     SETDISFROM                   SET *DISPLAY FROM*, SAVE LFN        #
#     SETKEY1                      SET *KEY IN LFN* FLAG IN BASICTABLE #
#     SETKEY2                      SET KEY LITERAL OR DATANAME FLAG    #
#                                                                      #
#----------------------------------------------------------------------#
  
      BEGIN 
  
      BASED ARRAY BASTEMP;              #TEMPORARY BASED ARRAY# 
        ITEM BTEMP; 
      ITEM BLK          I;
      XREF ITEM ATTR  I;           # LOC OF NEW -DESATT1- ENTRY        #
      XREF ITEM CURREG B;          # TRUE IF CURRENT-REGISTER          # QU3A334
      XREF ITEM CURRENTLFPTR I;    # PTR TO LFNINFO ENTRY FOR THIS LFN #
      XREF ITEM DESLIST I;         # DESCRIBE LIST PTR FOR CURRENT LF  #
      XREF ITEM DTP          I;    # DISPLY TABLE POINTER... INDEX     #
      XREF ITEM DIRAREA B;         # TRUE IF DISPLAY OR IF DIRECTIVE   #
                                   # REFERENCES AREA ITEMS             #
  
                                   # FLAGS TO TURN DIRECTORY ON/OFF    #
      XREF ARRAY DIRECTFLAG;       # FOR DISPLAY AND EXTRACT COMMANDS  #
        BEGIN 
        ITEM DIROVRIDE U(00,00,02);  # OVERRIDE OF -DISPDIR-/-EXTRDIR- #
        ITEM DISPDIR   B(00,02,01);  # CONTROLS DISPLAY DIRECTORY      #
        ITEM EXTRDIR   B(00,03,01);  # CONTROLS EXTRACT DIRECTORY      #
        ITEM DIRONOFF  B(00,04,01);  # TRUE IF DIRECTORY REQUESTED     #
        END 
                                   # VALUES FOR -DIROVRIDE-            #
      DEF UNSET    # 0 #;          # -DIROVRIDE- NOT USED              #
      DEF TURNON   # 1 #;          # DIRECTORY TURNED ON FOR THIS CMD  #
      DEF TURNOFF  # 2 #;          # DIRECTORY TURNED OFF FOR THIS CMD #
  
      XREF ITEM IMFDBM  B;         # TRUE IF IN IMF DATA BASE MODE     #
  
      ITEM EC  I;                  # FALSE IF -LINKNEWLFN- NOT CALLED  #
                                   # FROM -SORT-                       #
      ITEM I            I;         # SCRATCH TEMPORARY                 #
      ITEM J            I;         # SCRATCH TEMPORARY                 #
      ITEM K            I;         # SCRATCH TEMPORARY                 #
      ARRAY KEYELENT[0:EESIZEM1] S(1);  #ARRAY FOR BUILDING KEY EL. ENT#
        BEGIN 
        ITEM KEYEEWD U(0,0,60);    #USED TO MOVE KEY E. E. TO DTABLE   #
        END 
      BASED ARRAY GETA;            # ARRAY FOR RECEIVING VALUES        #
        BEGIN 
        ITEM GETAX I(0,0,60); 
        END 
  
      BASED ARRAY GIVEA;           # ARRAY FOR GIVING VALUES           #
        BEGIN 
        ITEM GIVEAX I(0, 0, 60);
        END 
      ITEM PFLOOPCTR    I;
*CALL DEFMURL 
      ITEM PWCNT        I;
      ITEM SAVEDES      I;         # TEMP HOLD FOR P<DESATT1>          #
      XREF ITEM FIELDNAMELG   I;   # LENGTH OF INDICE TABLE            #
      XREF ITEM FROMKEYINFIT I;    # ADDRESS OF *FROM* OR *KEY IN* FIT #
      XREF ITEM FRMLFN       C(7); # LFN OF -FROM- OR -KEY IN- FILE    #
      XREF ITEM SAVEDTYPE    I;    # DATA TYPE ON *KEY* DIRECTIVE      #
      XREF ITEM SAVELFNAME   I; 
      XREF ITEM SCANNING     B; 
      XREF ITEM SM$GROUPID   I;    # GROUP ID FOR CURRENT SYNTAX STUFF #
      XREF ITEM UPONLFN C(10);     # LFN OF -UPON- FILE                #
      BASED ARRAY TOATTRI;     # FOR SAVING ATTRIBUTES USED FOR CONVERT#
              ITEM TMRPT I(0,42,18),
                   TCLASS I(0,12,6),
                   TWPOS I(0,18,18),
                   TDISPSIZ I(0,9,6), 
                   TDECPT I(0,21,6),
                   TPICSIZ I(0,27,15),
                   TBPOS I(0,36,6), 
                   TLG I(0,42,18),
                   TMLG I(0,0,3), 
              TBP I(0,0,30),
              TWP I(0,30,30), 
                   TMURALPTR I(0,42,18),  # PTR TO MURAL               #
                   TMURAL I(0,0,60);  # MURAL                          #
      XREF PROC CHECKFORLFN;
      XREF PROC DIAG;              # ISSUE DIAGNOSTIC MESSAGE TO USER  #
      XREF PROC LFNLOOKUP;         # CHECK IF THIS LFN IS KNOWN        #
      XREF PROC LINKNEWLFN;        # LINK A NEW ENTRY INTO LFNLIST     #
      XREF PROC RECYES;            # RETURN STDYES IF RECORDING        #
      XREF FUNC SAVATTR I;
      XREF PROC SETDES;            # ALLOC AND SET A DESCRIBE ENTRY    #
  
  
  
  
#----------------------------------------------------------------------#
  
  
  
  
  XDEF  PROC DISPEND; 
        PROC DISPEND;      #  DISPLAY ENDING PROCEDURE    # 
  BEGIN 
      RECYES;                      # STDYES IF RECORDING               #
      P<BASICTABLE> = BASCPTR;
      P<DTABLE> = BASCADDR[BASTABIND];
  
      IF NOT IMFDBM                # IF NOT IN IMF DATA BASE MODE      #
        OR DESPASS                 # OR IF -DISPLAY FROM-              #
      THEN
        BEGIN 
                                   #IF KEY LITERAL OR KEY DATA-NAME    #
      IF BASCKEY1[BASTABIND] OR BASCKEY2[BASTABIND] THEN
        BEGIN 
        FOR K = 0 STEP 1 UNTIL EESIZE-1 DO
          BEGIN 
          CPENTRY[K] = KEYEEWD[K];  #MOVE KEY E. E. TO DTABLE          #
          END 
        END 
      ELSE
        BEGIN 
        FOR K = 0 STEP 1 UNTIL EESIZE-1 DO
          BEGIN 
          CPENTRY[K] = 0;          #NO KEY SO MOVE 0-S TO DTABLE       #
          END 
        END 
        END                        # END NOT IN IMF MODE               #
  
      IF SAVFSIZE[30] EQ 0         # IF NOT -SAME- DTABLE FROM BEFORE  #
      THEN
        BEGIN 
        FSIZE = PFLOOPCTR - BLK;   # NUM OF CHARS IN THIS DISPLAY LINE #
        SAVFSIZE[30] = FSIZE;      # SAVE TO USE IN EXECUTION OVERLAY  #
        END 
      DTP = 0;
                                   # ADD THE NEW -UPON- FILE AND ITS   #
                                   # DIRECTORY TO -LFNLIST-            #
      IF BASCUPON[BASTABIND]       # IF -UPON- FILE CREATED            #
      THEN
        BEGIN 
        SAVELFNAME = UPONLFN;      # RESTORE VALUE OF -UPON- LFN IN    #
                                   # CASE CHANGED BY -FROM- OR -KEY IN-#
        CHECKFORLFN;               # RELEASE LFN ENTRY IF PREV EXISTED #
        EC = 0;                    # FLAG NOT A CALL FROM -SORT-       #
        LINKNEWLFN (EC);           # LINK NEW LFN ONTO -LFNLIST-       #
        P<LFNINFO> = CURRENTLFPTR; # RESTORE PREVIOUS VALUE            #
        P<BASICTABLE> = BASCPTR;   # IN CASE CHANGED SINCE LAST SET    #
        BASFITUPON[BASTABIND] = LOC(L$FITLOC);  # FIT OF -UPON- LFN    #
        END                        # END -UPON- FILE                   #
  
      SM$GROUPID = 0;              # INDICATE NO CMM GROUP ID ALLOCATED#
      STDYES; 
   END
  
  
  
  
#----------------------------------------------------------------------#
  
  
  
  
  XDEF PROC DISPTBL;
       PROC DISPTBL;
   BEGIN
      RECYES;                      # STDYES IF RECORDING               #
      P<BASICTABLE> = BASCPTR;
        IF FROMKEYINFIT NQ 0       # IF *FROM* OR *KEY IN* FILE        #
          AND (NOT BASCUPON[BASTABIND])  # IF *UPON* NOT SPECIFIED     #
          AND (NOT BASCKEY3[BASTABIND])  # IF *KEY IN* NOT SPECIFIED   #
          AND BASCFROM[BASTABIND]        # IF *FROM* SPECIFIED         #
          AND (AREAITM                   # IF AREA ITEM TO BE DISPLAYED#
                OR IFFROMFLAG            #    OR *FROM* USED ELSEWHERE #
                OR FILEPASS)             #    OR FILE PASS NEEDED...   #
          THEN                           # THEN WE HAVE AN ERROR HERE. #
          BEGIN 
          CURRENTLFPTR = 0;        # FORGET CURRENT LFN                #
          IFFROMFLAG   = FALSE;    # FORGET USE OF FROM OPTION ELSEWHER#
          DESPASS      = FALSE;    # DONT PASS DESCRIBE / EXTRACT FILE #
          FILEPASS     = FALSE;    # DONT PASS AREA FILE(S)            #
          DIAG(207);               # ILLEGAL USE OF *FROM* OPTION      #
          STDNO;                   # ERROR -- SKIP REST OF TRANSMISSION#
          END 
  
      IF BASCUPON[BASTABIND]       # IF -UPON- FILE CREATED            #
      THEN
        BEGIN 
  
        IF (DISPDIR                # IF DISPLAY DIRECTORY REQUESTED    #
          AND DIROVRIDE NQ TURNOFF)# AND NOT TURNED OFF BY OVERRIDE... #
          OR DIROVRIDE EQ TURNON   # OR IF TURNED ON BY OVERRIDE       #
        THEN
          BEGIN 
          SETDES;                  # ALLOC AND SET A DESCRIBE ENTRY    #
          END 
  
        P<DESATT1> = ATTR;         # POSN TO NEWLY ALLOC ATTRIB ENTRY  #
  
        J = DECLASS[0]; 
        IF J EQ 2                  # IF -DISPLAY INTEGER- CLASS CODE   #
        THEN
          BEGIN 
          DECLASS[0] = 1;          # RESET TO -DISPLAY NUMERIC-        #
          END 
        IF J GQ 3                  # IF COMPUTATIONAL TYPES            #
        THEN
          BEGIN 
          DECLASS[0] = J + 8;      # BIAS TO DISPLAY-CODED TYPE        #
          END 
  
        IF DISPLAYSIZE[0] LS DPICSIZ[0]  # IF EDITING CHARS INSERTED   #
        THEN
          BEGIN 
          DECLASS[0] = 0;          # TREAT AS TYPE CHARACTER           #
          MURALPTR[0] = 0;         # USE DEFAULT MURAL                 #
          END 
        END                        # END -UPON- FILE CREATED           #
  
                                   # NOW SET DISPLAY TABLE ENTRY       #
           IF AREAITM THEN IF REFERFILE NQ O"77" THEN REFERFILE = 1;
           IF DTP EQ 0 THEN GOTO FISTIME; 
  
      IF DTP GQ 31 THEN GOTO TABLEFULL; 
  
FILLTABLE:  
      IF AREAITM                   # IF AREA-ITEM                      #
        AND (FIGLITDATA NQ 2       # NOT DEFINED-ITEM                  #
          OR (FIGLITDATA EQ 2      # DEFINED ITEM                      #
            AND SCANNING))         # SCAN(...)                         #
      THEN
        BEGIN 
        DIRAREA = TRUE;            # DISPLAY AREA-ITEM                 #
        IF NOT (BASCKEY1[BASTABIND]  # IF NOT DISPLAY KEY              #
          OR BASCKEY2[BASTABIND]
          OR BASCKEY3[BASTABIND]) 
        THEN
          BEGIN 
          FILEPASS = TRUE;
          SCANNING = FALSE; 
          END 
        END 
               IF FNEXT THEN    BEGIN 
          DIAG(199); STDNO; END 
  
  
      CPCVTCD[DTP] = C<DATATYPE,1>CCODE[DATATYPE];
          IF NOT ABSADDRESS THEN CPADDRFROM[DTP] = DATANAMEBASE;
      CPPKEY[DTP+1] = AKEYITEM;    # TRUE IF PRIMARY KEY               #
      CPKEYEXCL[DTP + 1] = EXCLKEYITEM; 
      CPRECDORD[DTP + 1] = DATARECDORD; 
      CPITEMORD[DTP + 1] = DATAITEMORD; 
      I = DTP -1 ;
      CPEDIT[I] = TRUE; 
      CPCHARLG[I] = RESULTSIZE; 
      CPFCHAR[I] = DATACHARPOS; 
      CPTCHAR[I] = PWCNT; 
      CPTOADDR[I] = K;
      IF BASCUPON[BASTABIND]       # IF DISPLAY IS TO BE TO A FILE     #
      THEN
        BEGIN 
        CPADDRTO[DTP] = LOC(TORECORDLOC);  # PTR TO FILE-S WSA         #
        END 
      ELSE                         # IF DISPLAY TO OUTPUT              #
        BEGIN 
        CPADDRTO[DTP] = LOC(DATALOC);  # PTR TO SCRATCH BUFFER         #
        END 
  
  
  
  DT2:    IF PROGSTACKLEN LS 0 THEN BEGIN 
DT1:  
          IF NOT INDICED           # IF SINGLE ITEM TO DISPLAY         #
            AND ((DATATYPE EQ 1    # RESULT SHOULD BE NUMERIC          #
                AND DATANAMEUSE NQ 1)  # AND CONVERSION IS REQUIRED    #
              OR (DATATYPE EQ 0    # RESULT SHOULD BE CHARACTER        #
              AND FIGLITDATA EQ S"LITERAL"))  # SOURCE IS LITERAL      #
          THEN
            BEGIN 
  
# SET UP DTABLE TO CALL MOVEC FOR DIRECT TRANSFER (NO CONVERSION)      #
  
      CPTYPE[I] = 1;
          J = 1;
      CPFROMADDR[I] = DATAWORDADDR; 
      END 
      ELSE
          BEGIN 
 # SET UP DTABLE FOR CALL TO CONVERT IN OVL 4-0                #
      CPTYPE[I] = 2;
  DT2A:   IF FIGLITDATA EQ 1 AND DATATYPE GR 1 THEN BEGIN 
    #  ITEM IS A CONSTANT LITERAL                                      #
      P<TOATTRI> = CMM$ALF(3,0,SM$GROUPID); 
      CPFROMADDR[I] = LOC(TOATTRI)-1; 
          TMRPT[1]=0; 
          TCLASS[0]=DATATYPE; 
          TPICSIZ[1]=PICSIZ[DATATYPE];
          TDECPT[1]=DECPT[DATATYPE];
          TDISPSIZ[1]=DISPSIZ[DATATYPE];
          TWPOS[0]=DATAWORDADDR;
          TBPOS[0]=0; 
      TLG[0] = SIZE[DATATYPE]*10; 
      CPCHARLG[I] = PICSIZ[DATATYPE]; 
      IF DEFMURAL[DATATYPE] NQ 0   # IF MURAL REQUIRED                 #
      THEN
        BEGIN 
        TMURALPTR[1] = 3;          # REL PTR TO MURAL                  #
        TMURAL[2] = DEFMURAL[DATATYPE];  # STORE MURAL                 #
        END 
      END 
      ELSE
  DT2B:   IF  FIGLITDATA NQ 1 THEN BEGIN
   #  ITEM IS  A  DATA-NAME                                            #
      SAVEDES = P<DESATT1>;        # SAVE POSITION OF -DESATT1-        #
          P<DESATT1>=DATANAMEPTR; 
      J = DATACHARPOS * 6;
      IF NOT INDICED AND (J NQ DBITPOS[0] OR DATAWORDADDR 
          NQ DEWPOS[0]) THEN
         BEGIN P<BASTEMP> = P<DESATT1>; 
        P<DESATT1> = CMM$ALF(7,0,SM$GROUPID); 
            FOR PFLOOPCTR = 0 STEP 1 UNTIL 6 DO 
              DDWORD0[PFLOOPCTR] = BTEMP[PFLOOPCTR];
            DEWPOS[0] = DATAWORDADDR; 
            DBITPOS[0] = J; 
      END 
      ELSE
      IF AREAITM THEN P<DESATT1> = SAVATTR; 
      CPFROMADDR[I] = P<DESATT1>; 
      P<DESATT1> = SAVEDES;        # RESTORE POSITION OF -DESATT1-     #
      END 
          J = 1;
  
              IF INDICED        THEN BEGIN
 # SET UP DTABLE FOR CALL TO FIGSUB  IN OVL 4-0             # 
      CPTYPE[I] = 4;
      P<INDTBL> = INDCTBLOC;
      CPSTACK[DTP] = INDCTBLOC;    # POINT TO INDICE TABLE             #
                                   # IF FALL IS TRUE THEN GET THE      #
                                   # UPPERBOUND OF THE LAST ENTRY      #
                                   # IN THE INDCE TABLE IN CASE THE    #
                                   # ITEM NAME WAS QUALIFIED           #
      IF FALL 
      THEN
        BEGIN 
        J = UPBND[FIELDNAMELG - 1]; 
        END 
      IF AREAITM THEN DATANAMEPTR = SAVATTR;
      CPFROMADDR[I] = DATANAMEPTR;
          END 
      END 
          END 
      ELSE
  
          IF PROGSTACKLEN GR 0 THEN BEGIN 
 # SET UP DTABLE FOR CALL TO EXPEVALUATE IN OVL 4-0         # 
      CPTYPE[I] = 3;
          J =1; 
          CPADDRFROM[DTP] = 0;
      CPSTACK[DTP] = PROGSTACKLOC;
      P<TOATTRI> = CMM$ALF(3,0,SM$GROUPID); 
      CPFROMADDR[I] = P<TOATTRI>-1; 
      TDISPSIZ[1] = DISPSIZ[DATATYPE];
      TDECPT[1] = DECPT[DATATYPE];
      TPICSIZ[1] = PICSIZ[DATATYPE];
      IF DEFMURAL[DATATYPE] NQ 0   # IF MURAL REQUIRED                 #
      THEN
        BEGIN 
        TMURALPTR[1] = 3;          # REL PTR TO MURAL                  #
        TMURAL[2] = DEFMURAL[DATATYPE];  # STORE MURAL                 #
        END 
          TWPOS[0]=RESULTSLOC;
          TCLASS[0]=RESULTUSAGE;
          TLG[0]=RESULTSIZE;
          IF DATATYPE EQ 0 THEN      # CHARACTER ITEM # 
            BEGIN 
            IF RESULTSIZE GQ PICSIZ[DATATYPE] THEN
              TPICSIZ[1] = RESULTSIZE;
            END 
      END 
      ELSE
      BEGIN 
  
  
     DIAG(200); STDNO;      #   INCORRECT DATA-TYPE .  NOT PROCESSED   #
      END 
          PFLOOPCTR = PWCNT + K * 10 + (CPCHARLG[I] + BLK) * J; 
      K = PFLOOPCTR / 10; 
      PWCNT =PFLOOPCTR - K * 10;
      DTP = DTP + EESIZE; 
      STDYES; 
  
  FISTIME:  
                 P<BASICTABLE>=BASCPTR; 
      P<DTABLE> = CMM$ALF(31,0,SM$GROUPID); 
      BASCADDR[BASTABIND] = P<DTABLE>;
  
      DTP = 1;                     # IDX INTO ENTRY-S 2ND WORD         #
      IF NOT IMFDBM                # IF NOT IN IMF MODE                #
        OR DESPASS                 # OR IF -DISPLAY FROM-              #
      THEN
        BEGIN 
        DTP = DTP + EESIZE;        # RESERVE FIRST ENTRY FOR KEY       #
        END 
  
      K = 0;                       # WORD ADDR OF ITEM IN DISPLAY      #
      IF ITEMSIZE                  # IF *SEP ITEM-SIZE* IN EFFECT      #
        AND BASCUPON[BASTABIND]    # AND OUTPUT GOING TO FILE          #
      THEN
        BEGIN 
        BLK = 0;                   # NO BLANK BETWEEN ITEMS            #
        PWCNT = 0;                 # FIRST ITEM STARTS AT CHAR 0       #
        END 
      ELSE                         # FOR ALL OTHER CASES               #
        BEGIN 
        BLK = 1;                   # ITEMS ARE PRECEDED BY A BLANK     #
        PWCNT = 1;                 # FIRST ITEM STARTS AT CHAR 1       #
        END 
  
      GOTO FILLTABLE;              # START FILLING TABLE               #
  
  
       TABLEFULL:  # #
      OVERFLOW[30] = CMM$ALF(31,0,SM$GROUPID);
      P<DTABLE> = OVERFLOW[30]; 
      DTP = 1;                     # START FILLING AT THE BEGINNING    #
      GOTO FILLTABLE;              # GO BACK TO FILLING THE TABLE      #
  END 
  
  
  
  
#----------------------------------------------------------------------#
  
  
  
  
       XDEF PROC SETDISFROM;
          PROC SETDISFROM;       # FIND LFN TO BE USED IN DIS FROM     #
            BEGIN 
            ITEM RC;
            IF FROMKEYINFIT NQ 0   # IF *FROM* OR *KEY IN*             #
            THEN
              BEGIN 
              DIAG (370); 
              STDNO;
              END 
  
            TYPEALOW = 7;          # ALLOW DESCRIBE, DEFINE, AND       #
                                   # LITERAL DATA ITEMS IN CONNECTION  #
                                   # WITH A FROM-FILE QUERY.           #
                                   # CONNECTION WITH -FROM- FILE       #
            RECYES;                # RETURN TO STDYES IF RECORDING     #
            RC = 0; 
            LFNLOOKUP (RC);      # LOCATE ADDRESS OF LFN TO BE USED.   #
            IF RC EQ 1 THEN      # ERROR--CAN"T FIND LFN.              #
              BEGIN 
              DIAG(314);
              STDNO;
              END 
            ELSE
              BEGIN 
              P<LFNINFO> = CURRENTLFPTR;
              DESLIST = 0;         # SO NOT TO CONFUSE -SETDES- IF     #
                                   # -UPON- FILE ALSO BEING CREATED    #
              DESPASS = TRUE; 
              P<BASICTABLE> = BASCPTR;
              BASFITFROM[BASTABIND] = LOC(L$FITLOC);                     UVESYN 
              FROMKEYINFIT = LOC(L$FITLOC); 
              FRMLFN = ILFN[IFRO]; # KEEP LFN OF -FROM- FILE           #
              BASCFROM[BASTABIND] = TRUE;  # *FROM* OPTION IN USE HERE #
              STDYES; 
              END 
            END   # SETDISFROM #
  
  
  
  
#----------------------------------------------------------------------#
  
  
  
  
    XDEF PROC SETKEY1;   # SET "KEY IN -LFN-" FLAG IN BASIC-TABLE    #
         PROC SETKEY1;
      BEGIN 
      ITEM EC;        # ENTRY CODE #
  
      RECYES;                      # STDYES IF RECORDING               #
      IF FROMKEYINFIT NQ 0         # IF *FROM* OR *KEY IN*             #
      THEN
        BEGIN 
        DIAG(370);
        STDNO;
        END 
      SAVELFNAME = 0; 
      B<0,ILFNLG[IIN]*6>SAVELFNAME = B<0,ILFNLG[IIN]*6>ILFN[IIN]; 
      P<BASICTABLE> = BASCPTR;
      BASCKEY3[BASTABIND] = TRUE; 
      IFFLAG = FALSE; 
      IF KEYLIT NQ 0 THEN 
        BEGIN 
        DIAG(204);
        STDNO;
        END 
      EC = 0; 
      LFNLOOKUP(EC);
      IF EC EQ 1                   # IF LFN NOT KNOWN                  #
      THEN
        BEGIN 
        EC = 0;                    # NOT SORT                          #
        DESLIST = 0;               # FILE HAS NO DESCRIBE ENTRY        #
        LINKNEWLFN (EC);           # LINK LFN INTO LFN LIST            #
        END 
      P<LFNINFO> = CURRENTLFPTR;
      BASFITFROM[BASTABIND] = LOC(L$FITLOC);                             UVESYN 
      FROMKEYINFIT = LOC(L$FITLOC); 
      USINGFLAG = TRUE; 
      DESLIST = 0;                 # RESET IN CASE -UPON- FILE USED    #
      FSIZE = 0;
      STDYES; 
      END 
  
  
  
  
#----------------------------------------------------------------------#
  
  
  
  
                           # THIS PROCEDURE IS CALLED IF KEY LITERAL  # 
    XDEF PROC SETKEY2;     # OR DATA-NAME  IS SPECIFIED IN THE  DISPLAY#
         PROC SETKEY2;     # DIRECTIVE.  IN EACH CASE A FLAG WILL BE SET
                 IN BASICTABLE AND THE KEY ATTRIBUTES WILLBE SAVED IN 
                 ARRAY KEYELENT TO BE MOVED INTO DTABLE BY DISPEND     #
  
   BEGIN
      RECYES;                      # STDYES IF RECORDING               #
          P<BASICTABLE>=BASCPTR;
      IF FIGLITDATA EQ 1 THEN 
         BASCKEY1[BASTABIND]=TRUE;
      ELSE BASCKEY2[BASTABIND]=TRUE;
      IF AREAITM                   # IF AREA-ITEM                      # QU3A334
        OR CURREG                  # IF CURRENT-REGISTER               # QU3A334
      THEN                                                               QU3A334
        BEGIN                                                            QU3A334
        DIAG(197);                 # KEY NOT IN TEMPORARY ITEM         # QU3A334
        STDNO;                                                           QU3A334
        END                                                              QU3A334
          IF KEYLIT NQ 0 THEN BEGIN DIAG(204); STDNO; END 
      KEYLIT = BASCPTR; 
      B<0,18>KEYLIT = BASTABIND;
      P<DTABLE> = LOC(KEYELENT);   #PREPARE TO BUILD KEY ELEMENTARY ENT#
      CPFCHAR[0] = DATACHARPOS; 
      IF RESULTUSAGE LQ 3          # IF NUMERIC, INTEGER, OR UNNORM    #
        AND RESULTUSAGE GQ 1
      THEN
        BEGIN 
        IF DATANAMEPTR EQ 0        # IF NO ATTRIB TABLE                #
                                   # FOR EXAMPLE, LITERAL INTEGER      #
        THEN
          BEGIN 
          DATANAMEPTR = CMM$ALF(3, 0, 0);  # ALLOCATE ATTRIBUTE TABLE  #
                                           # AND ROOM FOR LITERAL IN 1 #
                                           # BLOCK WITHOUT SM$GROUPID. #
                                           # RELEASESPACE WILL RELEASE #
                                           # THIS BLOCK SEPARATELY     #
          P<GETA> = DATANAMEPTR;   # POSITION TO NEW LITERAL SPACE     #
          P<GIVEA> = DATAWORDADDR;  # POSITION TO OLD LITERAL SPACE    #
          GETAX[0] = GIVEAX[0];    # MOVE LITERAL INTEGER              #
          CMM$FRF(DATAWORDADDR);   # RELEASE OLD LITERAL SPACE         #
          P<TOATTRI> = DATANAMEPTR + 1;  # 2ND WORD OF ATTRIB TABLE    #
          TWPOS[0] = DATANAMEPTR;  # STORE ADDR OF VALUE IN ATTRIB TBL #
          END 
        K = DATANAMEPTR;
        END 
      ELSE K = DATAWORDADDR;
      CPFROMADDR[0] = K;
      IF NOT ABSADDRESS THEN CPADDRFROM[1] = DATANAMEBASE;
      CPCHARLG[0] = DATALENG; 
      CPTYPE[0] = 2;
      CPPKEY[2] = TRUE;            # PRIMARY KEY                       #
      SAVEDTYPE = DATATYPE;        # SAVE CURRENT DATATYPE             #
      IF INDICED THEN 
      BEGIN CPSTACK[1] = INDCTBLOC; 
            CPTYPE[0] = 4;
      END 
      K = 0;
      STDYES; 
   END
  
  
  
  
#----------------------------------------------------------------------#
  
      END 
      TERM
