*DECK QDLBLD2                                                           000190
      PRGM DL30303;                # THIS IS 3,3 OVERLAY               #014890
      BEGIN                                                             014910
      DEF  NL        #  42#;       # NAME LENGTH IN BITS               #
      DEF  SSDIRLEN  #   8#;       # LENGTH OF SUB-SCHEMA CONTROL WD   #014930
      DEF  WL        #  60#;       # WORD LENGTH IN BITS               #
      DEF FITLENGTH #35#; 
         DEF  UPDATE  #O"25"#;
         DEF  FILLER  #O"3"#; 
         DEF  ENDOFAREA #O"7"#; 
         DEF  OCCUPIED  #1#;
         DEF  NULL      #0#;
         DEF NUMWDS    #B<0,6>#;
         DEF LEFT      #0#; 
         DEF ENDOFINDX #0#; 
          DEF DNTBASE  #FIRSTWORD#; 
         DEF  DOWNBOT #DDLMEM#; 
          DEF RECORD         #7#; 
          DEF AREA           #8#; 
          DEF QDGROUP        #00#;
          DEF QDREC          #00#;
          DEF REPGROUP       #02#;
          DEF REPINREP       #03#;
           DEF VECTOR #4#;
           DEF VECTORINREP #5#; 
          DEF SBAREA #O"10"#; 
       ARRAY SUBAREA[95]; 
          BEGIN 
            ITEM SBAREAWORD   U(00,00,60);
            ITEM SBARTYPE     U(00,00,06);
         ITEM SBARMULTREC U(0,36,1);
         ITEM SBAR U(0,6,12); 
         ITEM SBIN U(0,18,12);
         ITEM SBPV U(0,0,54); 
        ITEM SBARMIPFLG   U(00,35,01);
            ITEM SBARNEXT     U(00,48,12);
            ITEM SBARPRIOR    U(00,36,12);
            ITEM SBARNMLENW   U(00,06,06);
            ITEM SBARNMLENC   U(00,00,06);
            ITEM SBARPRIVPTR  U(00,12,12);
            ITEM SBARSDAPTR   U(00,24,12);
            ITEM SBARCOLOPT   U(00,40,01);
            ITEM SBARTEMP     U(00,41,01);
            ITEM SBARNEXTAR   U(00,42,18);
           ITEM SBARCOLLLENC  U(0,0,6);                                 000230
              ITEM SBARCOLLENW U(0,6,6);
            ITEM SBARCOLLPTR  U(00,00,12);
            ITEM SBARONPTR    U(00,12,12);
            ITEM SBARLOGPTR   U(00,24,12);
            ITEM SBARFITPTR   U(00,36,12);
          ITEM SBARRECPTR U(00,42,18);
         ITEM SBARLIBPTR U(0,48,12);
            ITEM SBARONPROC   U(00,00,42);
            ITEM SBARONDISP   U(00,49,01);
            ITEM SBARONMTCH   U(00,50,01);
            ITEM SBARONMSMTCH U(00,51,01);
            ITEM SBARONNEXT   U(00,52,01);
            ITEM SBARONOPEN   U(0,53,1);                                000400
            ITEM SBARONCLOSE  U(0,54,1);                                000410
            ITEM SBARONUPDTE  U(0,56,1);                                000430
            ITEM SBARONRETR   U(0,57,1);                                000440
            ITEM SBARLOGNAME  U(00,00,42);
            ITEM SBARLOGOPT   U(00,57,03);
            ITEM SBARLOGNMLEN U(00,00,06);
            ITEM SBARSEQOPT   U(00,39,01);
            ITEM SBARSORT     U(00,38,01);
            ITEM SBARDUPS     U(00,36,02);
            ITEM SBARFIT      U(00,00,60);
            ITEM SBARCOLLTBL  U(00,00,60);
            ITEM SBARSDAPRCNM U(00,00,60);
            ITEM SBWORD       U(00,00,60);
          END 
       BASED ARRAY AREABUF[95]; 
           BEGIN
            ITEM ARASCDSC     U(00,00,01);
            ITEM ARWORD       U(00,00,60);
         ITEM ARAR U(0,42,9); 
         ITEM ARIN U(0,51,9); 
            ITEM ARLOGOPT     U(00,01,03);
            ITEM ARTEMP       U(00,04,01);
            ITEM ARSORT       U(00,05,01);
            ITEM ARDUPS       U(00,06,02);
            ITEM ARCOLLATE    U(00,08,01);
            ITEM ARCLITLEN    U(00,09,06);
            ITEM ARCLITLENW   U(00,49,06);
        ITEM ARMIPFLG      U(00,45,01); 
      ITEM ARMULTREC U(0,46,1); 
            ITEM ARLOGPTR     U(00,21,06);
            ITEM ARSDANPTR    U(00,27,06);
            ITEM ARONCALL     U(00,33,06);
            ITEM ARCOLLPTR    U(00,15,06);
           ITEM ARPWORD      U(00,00,WL);        # WORD IN ARRAY       #
           ITEM ARONCWORD    U(00,00,WL);        # ON CALL WORD        #
           ITEM ARONCALLNM   U(00,00,NL);        # DBP NAME            #
           ITEM ARONCOPTN    U(00,NL,18);        # CALL OPTIONS        #
           ITEM ARONDISP     B(00,49,01);        # DISPLAY             #
           ITEM ARONMTCH     B(00,50,01);        # MATCH               #
           ITEM ARONMISM     B(00,51,01);        # MISMATCH            #
           ITEM ARONNEXT     B(00,52,01);        # NEXT FLAG           #
           ITEM ARONOPEN     B(00,53,01);        # OPEN                #
           ITEM ARONCLSE     B(00,54,01);        # CLOSE               #
           ITEM ARONUPDT     B(00,56,01);        # UPDATE              #
           ITEM ARONSRCH     B(00,57,01);        # SEARCH              #
            ITEM ARLOGNM      U(00,00,60);
            ITEM ARFITPTR     U(00,42,18);
              ITEM ARRECDPTR U(0,12,18);                                000120
         ITEM ARLIBPTR U(0,48,12);
           END
          ITEM  PUTLENG;
          ITEM  WORDLEN;
          ITEM  J;
          ITEM  K;
           ITEM ALG1; ITEM ALG2;
         XREF 
           BEGIN
           PROC ABRT1;                 # ABORT DDL                     #014950
           PROC DIAGS;                 # PUT DIAGNOSTIC TO OUTPUT FILE #014960
           PROC GETENT;                # READ FROM SCRATCH FILE        #014970
           PROC HASHDL;                # HASH DATA NAME                #014980
           PROC OPENZZ;                # OPEN SCRATCH FILE             #014990
           PROC PUTENT;                # WRITE TO SCRATCH FILE         #015000
           PROC QUDRTN4;               # LOAD AND EXECUTE OVERLAY (3,4)#015010
           PROC QUDRTN5;               # LOAD AND EXECUTE OVERLAY (3,5)#015020
                                                                        015030
      ITEM LIBFDB;           #FDB FOR SCHEMA LIBRARY FILE#
           ITEM SBLOCK; 
           ITEM DDLSU;             # STORAGE USED BY THIS COMPILATION  #
           ITEM ENDDNT; 
           ITEM EOMNDX;            # POINTER INTO EOMTABLE             #
           ITEM LOFANMS;
           ITEM NUMANMS;
           ITEM NUMDNMS;
           ITEM HRSLT1; 
           ITEM HRSLT2; 
           ITEM DIAGNOS;
          ITEM RELFLAG  B;
           ITEM AREALG; 
       ITEM DDLMEM; 
          ITEM FIRSTWORD; 
          ITEM CRMLEV;                           #CRM VERSION          #
          ITEM HDR3A;                            #DDL COMPILE DATE     #
          ITEM HDR4;                             #DDL VERSION          #
          ITEM HDR6;                             #TIME                 #
          ITEM JULDAT;                           #JULIAN DATE          #
           END
      ARRAY SBITM [40];                                                  D2A164 
            BEGIN                                                        D2A164 
          ITEM SBITMDATATYP  U(0,0,6);
           ITEM SBITMWORD    U(0,0,60); 
          ITEM SBITMLEVEL    U(0,6,6);
          ITEM SBITMRNLENC   U(0,12,6); 
          ITEM SBITMRNLENW   U(0,18,6); 
          ITEM SBITMDOMPTR   U(0,18,18);    # DOMINANT ITEM POINTER    #
          ITEM SBITMPRIPTR   U(0,36,12);
          ITEM SBITMNXTPTR   U(0,48,12);
          ITEM SBITMNLENC    U(0,0,6);
          ITEM SBITMNLENW    U(0,6,6);
          ITEM SBITMCLASS    U(0,12,6); 
          ITEM SBITMBWP      U(0,18,18);
          ITEM SBITMBBP      U(0,36,06);
          ITEM SBITMLEN      U(0,42,18);
          ITEM SBITMKEY      U(0,0,1);
          ITEM SBITMINOCC    U(0,1,1);
             ITEM SBITMDIMOCC  U(0,2,1);                                000870
             ITEM SBITM4THWRD  U(0,3,1);                                000880
             ITEM SBITMSIGNLOC U(0,4,5);                                000890
          ITEM SBITMALTKEY U(0,16,1); 
      ITEM SBITMAREDUP U(0,17,1); 
      ITEM SBITMALTDUP U(0,18,1); 
      ITEM SBITMUNIQNME U(0,19,1);     # FALSE = THERE IS ANOTHER ENTRY#
                                       #         WITH THE SAME NAME IN #
                                       #         ANOTHER AREA.         #
             ITEM SBITMEXPLOC  U(0,9,6);                                000900
             ITEM SBITMEXPLEN  U(0,15,5);                               000910
             ITEM SBITMACTASS  U(0,20,1);                               000920
        ITEM SBITMPNTLOC I(0,21,6);    #DECIMAL LOC. NEG IF TO LEFT.   #
             ITEM SBITMPICSIZ U(0,27,15);                               000940
           ITEM SBITMXPICSIZ  U(0,3,12);                                000950
             ITEM SBITMEDTPTR U(0,42,18);                               000950
          ITEM SBITMSYNPTR   U(0,0,18); 
          ITEM SBITMSAMPTR   U(0,18,18);
          ITEM SBITMCONPTR   U(0,36,12);
          ITEM SBITMPRVPTR   U(0,48,12);
          ITEM SBITMDIMFLG   U(0,0,1);
              ITEM SBITMMAXOCC   U(0,6,18);                             000470
      ITEM SBITMINOCCR U(0,24,18); # LOWER BOUND OF OCCURS CLAUSE      #
      ITEM SBITMDEPPTR U(0,42,18); # DEPENDING ON NAME POINTER         #
          ITEM SBITMDIM1     U(0,6,18); 
          ITEM SBITMDIM2     U(0,24,18);
          ITEM SBITMDIM3     U(0,42,18);
          ITEM SBITMNAME     U(0,0,60); 
          ITEM SBITMRNAME    U(0,0,60); 
             ITEM SBITMMURAL U(0,0,60);                                 001290
          ITEM SBITMDEPON U(0,1,1); 
             ITEM SBITMSIGN U(0,15,1);                                  000120
           END
          ARRAY USAGE[9]; 
            ITEM USAGELIST U(0,0,60) = [0,0,1,2,4,5,7,6,0,3];           000270
          ARRAY CODEPIC[10];
           ITEM CODEPICLIST U(0,0,60) = [0,1,1,2,2,2,2,2,0,2];
          ARRAY DEFLTPICSZ [9];                                         000310
      ITEM DEFLTSZ U(0,0,60) = [9(0)]; # PRESET ALL PIC SIZE           #
          ARRAY TYP[2]; 
            ITEM TYPELIST U(0,0,60) =[2,0,8]; 
       BASED ARRAY DATANAMETABL[1:100]; 
        BEGIN 
           ITEM RDENTRY      U(0,0,60); 
           ITEM RECDESCRADR  U(0,0,30); 
           ITEM AREALOC      U(0,30,30);
           ITEM AREANEXT     U(0,24,18);
          ITEM DNTWORD       U(0,0,60); 
          ITEM DNTSYNLINK   U(0,6,18);
           ITEM DNTITEMTYPE U(0,57,3);
          ITEM DNTNEXT      U(0,24,18); 
          ITEM DNTPRIOR     U(0,42,18); 
             ITEM ARNAMELEN    U(0,0,6)   ; 
             ITEM ARNAME       C(0,0,10)  ; 
             ITEM RDITEMTYPE   U(0,0,3)  ; # HASH LINK DESCRIPTOR#
             ITEM RDDATATYPE   U(0,3,3)  ;
             ITEM RDSYNLINK    U(0,6,18) ;
             ITEM RDDOMPTR     U(0,24,18);
             ITEM RDSAMENAME   U(0,42,18);
             ITEM RDLEVEL      U(0,0,6)  ; #NEXT / PRIOR POINTERS # 
             ITEM RDNEXT       U(0,24,18);
             ITEM RDPRIOR      U(0,42,18);
          ITEM RDNAMEPTR    U(0,7,8); 
         ITEM RDNAME       U(0,0,60); 
        END 
         BASED ARRAY OVERFLOW[0]; 
           BEGIN
              ITEM OVFLR2     U(0,0,10);
              ITEM OVFLBIAS   U(0,10,30); 
              ITEM OVFLAFLAG  U(0,40,1);
              ITEM OVFLNEXT   U(0,42,18); 
              ITEM OVFLWORD   U(0,0,60);
           END
         ARRAY HASH1024[1023];
           BEGIN
              ITEM  HASHR2      U(0,0,10);
              ITEM  HASHBIAS    U(0,10,30); 
              ITEM  HASHAFLAG   U(0,40,1);
              ITEM  HASHOCCUP   U(0,41,1);
              ITEM  HASHOCCUPOVF  U(0,42,01); 
              ITEM  HASHOVFLPTR U(0,43,17); 
           END
         ARRAY  NEWAREAINDX[4]; 
           BEGIN
              ITEM  AINDXLVL    U(0,0,2); 
              ITEM  AINDXRSLT   U(0,2,10);
              ITEM  AINDXNEXT   U(0,12,12); 
              ITEM  AINDXWORDAD U(0,30,30); 
              ITEM  ANAMELEN    U(0,0,6); 
              ITEM  ANAME1      U(0,6,54);
              ITEM  ANAME       U(0,0,60);
              ITEM  AINDXWORD   U(0,0,60);
           END
         ARRAY OLDAREAINDX[4];
          BEGIN 
             ITEM  OLDAINDXLVL  U(0,0,2); 
             ITEM  OLDAINDXRSLT U(0,2,10);
             ITEM  OLDAINDXNEXT U(0,12,12); 
             ITEM  OLDAINDXWADR U(0,30,30); 
             ITEM  OLDANAME     U(0,0,60);
             ITEM  OLDANAMELEN  U(0,0,6); 
             ITEM  OLDAWORD     U(0,0,60);
          END 
               ARRAY HASHINDX[9]; 
           BEGIN
              ITEM HIHTABLELEN  U(0,30,30);   # WORD 0 #
              ITEM HIHRECDADDR  U(0,30,30);  # WORD 1 # 
              ITEM HINDXRORL      U(0,0,1); 
              ITEM  HINDXPART     U(0,6,12);
              ITEM  HINDXCOUNT    U(0,30,12); 
              ITEM  HINDXPARTLOC  U(0,42,18); 
              ITEM  HINDXWORD     U(0,0,60);
           END
         BASED ARRAY HASHRESULT[0]; 
           BEGIN
              ITEM  HRSLTLVLL    U(0,0,2);
              ITEM  HRSLTL       U(0,2,10); 
              ITEM  HRSLTBIASL   U(0,12,18);
              ITEM  HRSLTLVLR    U(0,30,2); 
              ITEM  HRSLTR       U(0,32,10);
              ITEM  HRSLTBIASR   U(0,42,18);
              ITEM  HRSLTWORD    U(0,0,60); 
           END
         ITEM OVFLSIZE; 
         ITEM DNT;
              ITEM DATATYPE;                                            000590
          ITEM LASTLEVEL;                                               000200
         ITEM EQUALNAME;
         ITEM I;
         ITEM SAVEADDR; 
           ITEM ENDAINDEX;
         ITEM OVRPTR; 
         ITEM HPTR; 
         ITEM DNTPTR; 
         ITEM HIPTR;
         ITEM HRPTR;
         ITEM NEXTCELL; 
         ITEM WRITEWORD;
         ITEM BIAS; 
         ITEM NDNT; 
         ITEM LENGTH; 
         ITEM WORDADDR; 
         ITEM CURRENTAREA;
         ITEM AREAINDXADR;
         ITEM NAMECOUNT;
         ITEM ABIT; 
         ITEM ANAMESWITCH;
         ITEM NMPTR;
         ITEM INDXPART; 
         ITEM LEFTPART; 
         ITEM NUMENTRIES; 
         ITEM LENOFARINDX;
         ITEM LENOFRECHSH;
             ITEM TENCHAR;                                              000250
           ITEM BEGINHRPTR; 
          ITEM ENDOFIT = O"77000000000000000000"; 
         ITEM FILELIM I = 2000; 
          ARRAY SAVNAME[4]; 
            ITEM SAVENAME  U(0,0,60); 
          ITEM NAMELEN; 
        BASED ARRAY RECENTRY[20]; 
           BEGIN
              ITEM RECHASHLINK   U(0,0,60); 
              ITEM RECHLITEMTYP  U(0,0,3);
              ITEM RECHLDATATYP  U(0,3,3);
              ITEM RECHLSYN      U(0,6,18); 
              ITEM RECHLDOM      U(0,24,18);
              ITEM RECHLSAME     U(0,42,18);
              ITEM RECHLLVL      U(0,0,6);
              ITEM RECHLNAMELOC  U(0,7,8);
              ITEM RECHLNEXT     U(0,24,18);
              ITEM RECHLPRIOR    U(0,42,18);
              ITEM RECNAMELEN    U(0,0,6);
              ITEM RECNAMELENC U(0,19,5);                               000570
              ITEM RECNAME       U(0,0,60); 
          ITEM RECHLOCCURS U(0,1,1);
          ITEM RECHLOCCURSR U(0,0,1); 
        ITEM RECHLPTLORR B(0,3,1); #TRUE=POINT TO LEFT  OF DEFAULT POS.#
          ITEM RECHLPTCOUNT U(0,4,5); 
          ITEM RECHLPTAORV  U(0,2,1); 
          ITEM RECHLUSAGE   U(0,9,4); 
            ITEM RECHLCLASS    U(0,13,04);       # ITEM CLASS          # D2A164 
          ITEM RECHLKEYITM  U(0,17,1);
            ITEM RECHLRECSZ    U(0,18,18);       # RECORD USE SIZE     #
            ITEM RECHLPICSIZ   U(0,18,12);       # PICTURE SIZE        # D2A164 
            ITEM RECHNMINSRTS  U(0,30,06);       # NUMBER OF INSERTS   # D2A164 
          ITEM RECHLIPICSIZ U(0,18,7);                                  000790
          ITEM RECHLXPICSIZ U(0,25,6);                                  000800
          ITEM RECHLUSESIZ U(0,31,5);                                   000760
          ITEM RECHLBWP     U(0,36,18); 
          ITEM RECHLBBP     U(0,54,6);
          ITEM RECDEPEND U(0,0,1);
          ITEM RECHLALTKEY U(0,2,1);
          ITEM RECHLALTDUP U(0,3,1);
         ITEM RECHLAREDUP U(0,4,1); 
          ITEM RECHLUNIQNME U(0,5,1);  # FALSE = THERE IS ANOTHER ENTRY#
                                       #         WITH THE SAME NAME IN #
                                       #         ANOTHER AREA.         #
          ITEM RECVALUE3 U(0,6,18);  # UPPER BOUND OF OCCURS CLAUSE    #
          ITEM RECVALUE4    U(0,24,18); 
          ITEM RECDEPOBJ    U(0,42,18); 
          ITEM RECNULLVAL  U(0,0,3);
          ITEM RECYCLPTLENW  U(0,3,6);
          ITEM RECYCLPTLENC  U(0,9,6);
          ITEM RECYCLPTNM U(0,0,60);
            ITEM RECEDPTR  U(0,15,4);                                   000930
             ITEM RECMURAL U(0,0,60);                                   001270
             ITEM RECHLSIGN U(0,30,30); 
           END
                                                                        015110
      BASED ARRAY SCHBLOCK [0] S(SSDIRLEN);  # SS DIRECTORY CTLWD LENG #015120
        BEGIN                                                           015130
*CALL COMQUSBLK                                                         015140
        END                                                             015150
                                                                        015160
      BASED ARRAY SCRATCHARRAY[0];
         ITEM SCELL U(0,0,60);
      ITEM LIBFDBLG;         #LENGTH OF LIBRARY FDB#
          ARRAY DOMADJLEN [48];                                         000170
            ITEM ADJLEN U(0,0,60);                                      000180
      CONTROL EJECT;                                                    015180
#**********************************************************************#015190
#                                                                      #015200
#          E X E C U T A B L E   C O D E   F O R   Q D L B L D 2       #015210
#                                                                      #015220
#**********************************************************************#015230
                                                                        015240
                                                                        015250
           OPENZZ;                 # OPEN SCRATCH FILE                 #015260
           NAMECOUNT = 0; 
           BIAS = 0;
           P<DATANAMETABL> = DNTBASE; 
           ZEROBUF(HASHINDX,10);                                        000120
           P<SCHBLOCK> = LOC(SBLOCK); 
           P<OVERFLOW> =  DNTBASE + ENDDNT + 1; 
           OVFLSIZE = DOWNBOT - (DNTBASE + ENDDNT); 
          ENDAINDEX = 0;
      DDLSU = (DNTBASE + ENDDNT - EOMNDX + 63) / 64 * 64;  # ROUND UP  #
           LENOFRECHSH = (10+NUMDNMS/2) * NUMANMS + 100;
           LENOFARINDX = LOFANMS + NUMANMS; 
           FILELIM   = ENDDNT  + LENOFARINDX + LENOFRECHSH; 
          #  AT  THIS  POINT IT  MAY  BE  NECESSARY  TO  PREALLOCATE #
          #  THE  REQUIRED SPACE  BUT  AT  THIS TIME  6RM  HAS NOT   #
          #  SPECIFIED HOW TO DO THIS                                #
           DNT = 1;    # INIT THE  DATA NAME TABLE PTR #
      P<SCRATCHARRAY>=LOC(LIBFDB);
      IF SCELL[0] NQ 0 THEN 
         BEGIN               #LIBRARY FILE SPECIFIED# 
         FOR I=5 STEP 1 UNTIL 14 DO 
            BEGIN 
            IF SCELL[I] EQ O"55555555555555555500" THEN 
               BEGIN
               LIBFDBLG=I+1; #LENGTH OF LIBRARY FDB#
               I=14;         #FORCE LOOP END# 
               END
            END 
         END
         ELSE 
         LIBFDBLG=0;         #NO LIBRARY FILE#
         WRITEWORD = SSDIRLEN + 1 + LIBFDBLG;    # FIRST RECORD ENTRY  #015380
       GETAREA: 
           ALG1=WRITEWORD;
           RECDESCRADR[DNT+7] = WRITEWORD; # STORE THE 6RM WORD ADDR  # 
                                           # AT WHICH THE AREA NAMED  # 
                                           # RECORD DESCRIPTIONS WILL # 
                                           # BEGIN                    # 
           ZEROBUF(HASH1024,1024);                                      000140
      ZEROBUF(OVERFLOW,OVFLSIZE-1); 
         NEXTCELL =0; 
         NAMECOUNT = 0; 
          BIAS =0;
         ANAMESWITCH = 0; 
         ABIT = 0;
          CURRENTAREA = DNT;
          DNT = RDNEXT[DNT+1] + DNT;
       GETNAME: 
          NDNT = DNT + RDNAMEPTR[DNT+1];
          NAMELEN = B<0,6> RDNAME[NDNT];
          FOR I = 0 STEP 1 UNTIL NAMELEN   - 1 DO 
            BEGIN 
             B<0,54> SAVENAME[I] = B<6,54> RDNAME[NDNT + I];
             B<54,6> SAVENAME[I] = B<0,6>   RDNAME[NDNT + I + 1]; 
            END 
          B<54,6> SAVENAME[I-1] = O"55";
               IF B<0,6>SAVENAME[I-1] EQ O"55" THEN                     000220
                 NAMELEN = NAMELEN - 1;                                 000230
          RDSAMENAME[DNT] = 0;
          RDSYNLINK[DNT] = 0; 
                   #  CLEAR POINTERS FOR HASHING NEW POINTERS  #
                   #  FOR SYNONYMS AND SAME NAMES  #
          IF RDDATATYPE[DNT] EQ  FILLER THEN GOTO BYPASSHASH; 
          DHASHST(LOC(SAVENAME[0]));   # CALL HASH #
                                          # TO HASH THE NAME AND# 
                                          # BUILD THE HASH TREE # 
       BYPASSHASH:  
          WORDADDR = WRITEWORD + BIAS; # CALC 6RM WORD ADDR AT WHICH TO#
                                       # WRITE THIS ENTRY              #
            QDTOSBMAP;
           LENGTH = SBITMNXTPTR[0];                                     000170
          PUTENT(LOC(SBITM),LENGTH,WORDADDR); 
          BIAS = BIAS + LENGTH; 
      DNT = DNT + RDNEXT[DNT+1];
           IF  RDITEMTYPE[DNT] EQ ENDOFAREA THEN GOTO PUTHASH;
           GOTO GETNAME;
         PUTHASH: 
          WORDADDR = WORDADDR + SBITMNXTPTR[0];                         000150
          PUTENT(LOC(ENDOFIT),1,WORDADDR);
         BIAS = BIAS+1; 
  
            #   WRITE AREA INFO AT END OF RECORD DESCRIPTION #
  
          P<AREABUF> = LOC(RDENTRY[CURRENTAREA]); 
           QDAREAMAP; 
           LENGTH = I;
           WORDADDR = WRITEWORD + BIAS; 
           AREALOC[CURRENTAREA+7] = WORDADDR; #TO BE USED WHEN THE AREA#
                                              #NAMES ARE HASHED        #
          DNTITEMTYPE[CURRENTAREA] = AREA;
          PUTENT(LOC(SUBAREA),LENGTH,WORDADDR); 
           BIAS = BIAS + LENGTH;
  
             #  BUILD AND WRITE RECORD HASH TABLE # 
  
           BUILDHASH; 
  
           IF AREANEXT[CURRENTAREA] NQ NULL THEN
               DNT = AREANEXT[CURRENTAREA]; 
           ALG2=WRITEWORD+BIAS-ALG1;
           IF ALG2 GR AREALG THEN AREALG=ALG2;
          IF DNT LS ENDDNT THEN 
             BEGIN
               WRITEWORD = WRITEWORD + BIAS;
               BIAS = 0;
               GOTO GETAREA;
             END
           AREAINDXADR = WRITEWORD +BIAS; 
           BUILDARINDX; 
           GOTO FINISHED; 
  
  
  
         PROC DHASHST(DATANM);
  
           BEGIN
          BASED ARRAY DATANM[3];
              ITEM  DATANAME   U(0,0,60); 
         ARRAY DNNAME[3]; 
             ITEM DNAME U(0,0,60);
            FOR I=0 STEP 1 UNTIL NAMELEN - 1 DO 
                 DNAME[I] = DATANAME[I];
          HASHDL(LOC(DNNAME),NAMELEN);                                  000255
           IF HASHOCCUP[HRSLT1]  EQ  OCCUPIED THEN GOTO CHECKOVERFL;
           HASHOCCUP[HRSLT1] = OCCUPIED;
           HASHBIAS[HRSLT1] = BIAS; 
           HASHR2[HRSLT1]  = HRSLT2;
           NAMECOUNT = NAMECOUNT + 1; 
           RETURN;
         CHECKOVERFL: 
           IF HASHOCCUPOVF[HRSLT1] NQ NULL THEN GOTO CHECKOVERFL2;
           HASHOCCUPOVF[HRSLT1] = 1;
           HASHOVFLPTR[HRSLT1] = NEXTCELL;        # PROPAGATE THE HASH #
           OVFLR2[NEXTCELL] = HASHR2[HRSLT1];     # ENTRY TO THE OVERFL#
           OVFLBIAS[NEXTCELL] = HASHBIAS[HRSLT1]; 
           OVFLAFLAG[NEXTCELL] = ABIT;
           OVFLNEXT[NEXTCELL] = NULL; 
           NEXTCELL = NEXTCELL + 1; 
         CHECKOVERFL2:  
           OVRPTR = HASHOVFLPTR[HRSLT1];
         CHECKOVLOOP: 
           IF HRSLT2 EQ  OVFLR2[OVRPTR] THEN GOTO CHECKNAME;
         CHECKOVCONT: 
           IF OVFLNEXT[OVRPTR] NQ NULL THEN 
            BEGIN 
             OVRPTR = OVFLNEXT[OVRPTR]; 
             GOTO CHECKOVLOOP;
            END 
           OVFLNEXT[OVRPTR] = NEXTCELL; 
           OVRPTR = NEXTCELL; 
           OVFLR2[OVRPTR] = HRSLT2; 
           OVFLBIAS[OVRPTR] = BIAS; 
           OVFLAFLAG[OVRPTR] = ABIT;
           OVFLNEXT[OVRPTR] = NULL; 
           NAMECOUNT = NAMECOUNT + 1; 
           NEXTCELL = NEXTCELL +1;
           IF NEXTCELL EQ OVFLSIZE THEN     # IF EXCEED FL             #015280
             ABRT1;                         # DDL ABORT                #015290
            RETURN; 
         CHECKNAME: 
           WORDADDR = OVFLBIAS[OVRPTR] + WRITEWORD; 
           LENGTH = 10; 
         GETRECNAME:  
         LENGTH = 10; 
          GETENT(LOC(SBITM),LENGTH,WORDADDR); 
                   # READ ENTRY THAT HAS ALREADY BEEN WRITTEN#
           EQUALNAME = 0; 
            NMPTR = 4;                                                  000530
          FOR I = 0 STEP 1 UNTIL NAMELEN - 1 DO 
               BEGIN                                                    000490
             IF SAVENAME[I] EQ SBITMNAME[NMPTR+I] THEN
               EQUALNAME = EQUALNAME + 1; 
               END                                                      000510
             IF EQUALNAME EQ NAMELEN THEN GOTO SAMENAME;
             IF SBITMSYNPTR[3] EQ NULL THEN 
               BEGIN
              SBITMSYNPTR[3] = WRITEWORD + BIAS;                        000450
                 LENGTH = 10; 
                 PUTENT(LOC(SBITM),LENGTH,WORDADDR);
              RETURN; 
             END
           WORDADDR = SBITMSYNPTR[3];                                   000550
           GOTO GETRECNAME; 
         SAMENAME:  
            IF SBITMSAMPTR[3] EQ NULL THEN
             BEGIN
              SBITMSAMPTR[3] = WRITEWORD + BIAS;                        000470
         LENGTH = 10; 
          PUTENT(LOC(SBITM),LENGTH,WORDADDR); 
               RETURN;
             END
           WORDADDR = SBITMSAMPTR[3];                                   000570
         LENGTH = 10; 
          GETENT(LOC(SBITM),LENGTH,WORDADDR); 
           GOTO SAMENAME; 
           END      #  END OF DHASHST  #
  
  
  
  
      CONTROL EJECT;
  
      PROC BUILDHASH;              # BUILD HASH TABLE                  #
  
      ITEM LASTSLOT;
  
      BEGIN 
  
      LASTSLOT = 0; 
           HIPTR= 2;
           HPTR = 0;
           OVRPTR = 0;
           HRPTR = 0; 
           P<HASHRESULT> = LOC(OVFLNEXT[NEXTCELL]) + 1; 
           INDXPART= 128; 
           LEFTPART = 0;     # FILL UP LEFT PART OF HASH TABLE FIRST# 
           NUMENTRIES = 0;   # NUMBER OF ENTRIES FOR EACH PART      # 
           BEGINHRPTR  = 0; 
      FOR I = 0 STEP 1 UNTIL NAMECOUNT + NEXTCELL - 1 DO
             HRSLTWORD[I] = 0;
           ZEROBUF(HASHINDX,10);                                        000160
         GETHASHENT:  
           IF HASHOCCUP[HPTR] NQ OCCUPIED THEN GOTO CHECKPARTLIM; 
           IF LEFTPART NQ LEFT THEN GOTO STORERIGHT;
           HRSLTL[HRPTR] = HPTR;  # HPTR CORRESPONDS TO THE FIRST 10 #
                                  # BITS OF THE HASHED RESULT,SINCE  #
                                  # THE HASH TABLE IS FIXED LENGTH   #
           HRSLTLVLL[HRPTR] = 0;
           HRSLTBIASL[HRPTR] = HASHBIAS[HPTR];
           HRPTR = HRPTR + 1; 
           NUMENTRIES = NUMENTRIES +1;
           IF HASHOCCUPOVF[HPTR] EQ NULL THEN GOTO CHECKPARTLIM;
           OVRPTR = HASHOVFLPTR[HPTR];
      FOR I = 1 WHILE I NQ 0 DO 
           BEGIN
           HRSLTL[HRPTR] = OVFLR2[OVRPTR];
           HRSLTLVLL[HRPTR] = 1;
           HRSLTBIASL[HRPTR] = OVFLBIAS[OVRPTR];
           NUMENTRIES = NUMENTRIES +1;
           HRPTR = HRPTR+1; 
           OVRPTR = OVFLNEXT[OVRPTR]; 
           I = OVRPTR;
           END
         CHECKPARTLIM:  
         CHECKLIM:  
           IF (HPTR + 1) - INDXPART NQ 0 THEN GOTO INCRHPTR;
              # THE HASH INDEX HAS 8 WORDS EACH WORD INDICATING#
              # 128 POSSIBLE ENTRIES AND THEIR LOCATION IN THE #
              # HASH TABLE IF THE ABOVE RESULT IS ZERO THEN 128#
              # ENTRIES HAVE BEEN MADE AND IT IS TIME TO STORE #
              # THE LOCATION IN THE HASH INDEX                 #
           HINDXPARTLOC[HIPTR] = BEGINHRPTR;
           HINDXCOUNT[HIPTR] = NUMENTRIES    ;
            HINDXPART[HIPTR] = HPTR - 127;
           IF BEGINHRPTR LS HRPTR THEN
              HINDXRORL[HIPTR] = LEFTPART;
           HIPTR = HIPTR + 1; 
           INDXPART = INDXPART + 128; 
           NUMENTRIES = 0 ; 
      BEGINHRPTR = LASTSLOT;
      LASTSLOT == HRPTR;
           LEFTPART = 1 - LEFTPART; 
  
INCRHPTR:                                        # INCREMENT POINTER   #
  
      HPTR = HPTR + 1;
      IF  HPTR GR 1023
      THEN BEGIN                                 # HASH TABLE IS FULL  #
           IF LASTSLOT GR HRPTR 
           THEN HRPTR = LASTSLOT; 
           WORDADDR = WRITEWORD + BIAS; 
           HIHTABLELEN[0] = HRPTR ;              # LENGTH OF HASH TABLE#
           HIHRECDADDR[1] = RECDESCRADR[CURRENTAREA+7]; # WA OF RECO   #
           LENGTH = 10; 
           PUTENT (LOC(HASHINDX),LENGTH,WORDADDR); # WRITE HASH INDEX  #015070
           LENGTH = HRPTR;                  # LENGTH OF HASH RESULT    #
           WORDADDR = WORDADDR + 10;
           PUTENT (LOC(HASHRESULT),LENGTH,WORDADDR); # WRITE HASH RESLT#015090
           BIAS = BIAS + 10 + HRPTR;
           RETURN;
           END
      GOTO GETHASHENT;
  
STORERIGHT: 
  
           HRSLTR[HRPTR] = HPTR;
           HRSLTLVLR[HRPTR] = 0;
           HRSLTBIASR[HRPTR] = HASHBIAS[HPTR];
           HRPTR = HRPTR + 1; 
           NUMENTRIES = NUMENTRIES + 1; 
           IF HASHOCCUPOVF[HPTR] EQ NULL THEN GOTO CHECKPARTLIM;
           OVRPTR = HASHOVFLPTR[HPTR];
         STORERIGHT11:  
           HRSLTLVLR[HRPTR] = 1;
           HRSLTR[HRPTR] = OVFLR2[OVRPTR];
           HRSLTBIASR[HRPTR] = OVFLBIAS[OVRPTR];
           NUMENTRIES = NUMENTRIES + 1; 
           HRPTR =HRPTR +1; 
         STORERIGHT2: 
           IF OVFLNEXT[OVRPTR] EQ NULL THEN GOTO CHECKLIM;
          OVRPTR = OVFLNEXT[OVRPTR];
           GOTO STORERIGHT11; 
           END     #  END OF BUILDHASH #
  
  
  
  
  
         PROC BUILDARINDX;
  
         BEGIN
           DNTPTR = 1;
           ZEROBUF(NEWAREAINDX,5);                                      000180
           ZEROBUF(OLDAREAINDX,5);                                      000190
           ZEROBUF(HASH1024,1024);                                      000200
           ZEROBUF(OVERFLOW,OVFLSIZE-1);                                000210
           ANAMESWITCH = 1; 
             SAVEADDR = AREAINDXADR;
         GETANAME:  
          ANAMELEN[0] = NUMWDS ARNAME[DNTPTR+2];
           AINDXWORDAD[0] = AREALOC[DNTPTR +7]; 
             FOR I = 0 STEP 1 UNTIL NUMWDS ARNAME[DNTPTR+2] -1 DO 
          BEGIN 
            B<0,54> ANAME[1+I] = B<6,54> ARNAME[DNTPTR+2+I];
            B<54,6> ANAME[1+I] = B<0,6> ARNAME[DNTPTR + 3 + I]; 
          END 
            B<54,6> ANAME[I] =  O"55";
          IF B<0,6> ANAME[I] EQ O"55" THEN
            ANAMELEN[0] = ANAMELEN[0] - 1;
          LENGTH = ANAMELEN[0] + 1; 
             PUTENT(LOC(NEWAREAINDX),LENGTH,SAVEADDR);
             SAVEADDR = SAVEADDR+LENGTH;
             DNTPTR = AREANEXT[DNTPTR]; 
          IF DNTPTR NQ 0                                                015400
            AND DNTPTR LS ENDDNT                                        015410
          THEN                                                          015420
            GOTO GETANAME;                                              015430
          GOTO WRITESBLOCK;            # WRITE SS DIRECTORY CTL WORD   #015440
                                                                        015450
         GETANAMES: 
             DNTPTR =1; 
             GETENT(LOC(OLDAREAINDX),5,WORDADDR); 
             IF OLDAWORD[0] EQ ENDOFINDX THEN GOTO WRITESBLOCK; 
         COMPNEXT:  
             EQUALNAME = 0; 
          LENGTH = OLDANAMELEN[0];
          FOR I = 0 STEP 1 UNTIL NUMWDS ARNAME[DNTPTR + 2] - 1 DO 
             BEGIN
               B<0,54> SAVENAME[I] =   B<6,54> ARNAME[DNTPTR+2+I];
               B<54,6> SAVENAME[I] =   B<0,6> ARNAME[DNTPTR + 3 + I]; 
             END
               B<54,6> SAVENAME[I-1] =  O"55";
             FOR I = 0 STEP 1 UNTIL LENGTH - 1  DO
               BEGIN
             IF SAVENAME[I] EQ OLDANAME[I+1] THEN 
                 EQUALNAME = EQUALNAME +1;
             END
             IF EQUALNAME EQ LENGTH THEN GOTO USENEWNAME; 
             DNTPTR = AREANEXT[DNTPTR]; 
             IF DNTPTR LS ENDDNT THEN GOTO COMPNEXT;
             LENGTH = LENGTH+1; 
             PUTENT(LOC(OLDAREAINDX),LENGTH,SAVEADDR);
             SAVEADDR = SAVEADDR + LENGTH;
             WORDADDR = LENGTH + WORDADDR;
             GOTO GETANAMES;
           USENEWNAME:  
             WORDADDR = WORDADDR + LENGTH +1; 
             GOTO GETANAMES;
           WRITESBLOCK: 
             PUTENT(LOC(ENDAINDEX),1,SAVEADDR); 
           SAREAINDXADR[0] = AREAINDXADR; # SS AREA INDEX TABLE ADDRESS#015470
           SAREAINDXLEN[0] = SAVEADDR - AREAINDXADR;                    015480
                                          # SS AREA INDEX TABLE LENGTH #015490
        IF RELFLAG THEN                   # IF RELATION FLAG IS SET    #015500
          SRELINDXADR[0] = SAVEADDR;      # WA OF RELATION INDEX TABLE #015510
        SCDATE[0] = B<30,30>JULDAT;              #SS COMPILE DATE      #
        SCTIME[0] = B<6,30>HDR6;                 #SS COMPILE TIME      #
        SDDLVER[0] = C<7,3>HDR4;                 #DDL VERSION          #
        SCRMVER[0] = C<0,3>CRMLEV;               #CRM VERSION          #
        SBDATE[0] = C<4,5>HDR3A;                 #DDL BUILD DATE       #
      PUTENT(LOC(SCHBLOCK),9,0); #RESERVE 4 WORDS FOR SCHEMA BLOCK# 
      IF SAREAINDXLIB[0] THEN      # IF DATA BASE PROC. LIB. FDB EXISTS#015530
         PUTENT(LOC(LIBFDB),LIBFDBLG,9); #WRITE LIB FDB FOLLOWING      #
                                         #SCHEMA BLOCK IN SUBSCHEMA#
             RETURN;
         END      # END OF BUILDARINDX #
          PROC QDTOSBMAP; 
            BEGIN 
             P<RECENTRY> = LOC(RDENTRY[DNT]); 
      FOR  I = 0 STEP 1 UNTIL 40  DO                                     D2A164 
             SBITMWORD[I] = 0;
             DATATYPE = RECHLDATATYP[0];                                000640
           IF DATATYPE EQ QDREC THEN                                    000520
          FOR I=1 STEP 1 UNTIL 47 DO                                    000220
            ADJLEN[I] = 0;                                              000230
             SBITMLEVEL[0] = RECHLLVL[1];                               000650
             SBITMPRIPTR[0] = RECHLPRIOR[1];                            000670
             SBITMNXTPTR[0] = RECHLNEXT[1];                             000680
             SBITMNLENC[1] = RECNAMELENC[1];                            000690
             SBITMUNIQNME[2] = RECHLUNIQNME[3]; 
           IF RECHLSYN[0] NQ 0 THEN                                     000680
             SBITMSYNPTR[3] = RECHLSYN[0];                              000690
           IF RECHLSAME[0] NQ 0 THEN                                    000700
             SBITMSAMPTR[3] = RECHLSAME[0];                             000710
             IF DATATYPE EQ QDREC THEN                                  000720
               BEGIN                                                    000730
                 SBITMDATATYP[0] = RECORD;                              000740
                 SBITMLEN[1] = RECHLRECSZ[2]; 
                 GOTO STORESBNAME;                                      000750
               END                                                      000760
             SBITMCLASS[1] = USAGELIST[RECHLUSAGE[2]];                  000770
          SBITMDATATYP[0] = RECHLITEMTYP[0];                            000375
      IF  RECHLCLASS[2] LQ 5 AND                                         D2A164 
          RECHLCLASS[2] NQ 4 AND                                         D2A164A
          RECHLCLASS[2] NQ 2                                             D2A164 
      THEN BEGIN                                                         D2A164 
           SBITMLEN[1] = RECHLPICSIZ[2] - RECHNMINSRTS[2];               D2A164 
           SBITMPICSIZ[2] = RECHLPICSIZ[2];                              D2A164 
           SBITMXPICSIZ[2] = SBITMLEN[1];                                D2A164 
           END                                                           D2A164 
      ELSE BEGIN                                                         D2A164 
           SBITMPICSIZ[2] = RECHLIPICSIZ[2];
           SBITMXPICSIZ[2] = RECHLXPICSIZ[2]; 
           SBITMLEN[1] = RECHLUSESIZ[2];
           END
      IF RECHLITEMTYP[0] EQ 0          # GROUP ITEM                    #
      THEN SBITMLEN[1] = RECHLRECSZ[2]; 
             SBITMBWP[1] = RECHLBWP[2];                                 000780
           SBITMBBP[1] = RECHLBBP[2] * 6;                               000480
             SBITMKEY[2] = RECHLKEYITM[2];                              000800
      SBITMALTKEY[2] = RECHLALTKEY[3];
      SBITMALTDUP[2] = RECHLALTDUP[3];
      SBITMAREDUP[2] = RECHLAREDUP[3];
          SBITMSIGN[2] = RECHLSIGN[3];                                  000140
             SBITMINOCC[2] = RECHLOCCURS[2];                            000810
             SBITMDIMOCC[2] = RECHLOCCURSR[2];                          000820
             SBITMPNTLOC[2] = RECHLPTCOUNT[2];                          000830
             IF  RECHLPTLORR[2] THEN   #DEC PT TO LEFT OF DEFAULT.     #
               SBITMPNTLOC[2] = - SBITMPNTLOC[2]; 
             SBITMUNIQNME[2] = RECHLUNIQNME[3]; 
           IF SBITMPICSIZ[2] EQ 0 THEN                                  000340
             BEGIN                                                      000345
             SBITMPICSIZ[2] = DEFLTSZ[RECHLUSAGE[2]];                   000350
           IF SBITMLEN[1] EQ 0 THEN                                     000370
             SBITMLEN[1] = 10;                                          000380
             END                                                        000385
  STORESBNAME:  #   #                                                   000850
             SBITMNLENW[1] = B<0,6> RECNAME[RECHLNAMELOC[1]]; 
          K = RECHLNAMELOC[1];
             J = 4;                                                     001010
          WORDLEN = RECNAMELEN[K] - 1;
          IF LASTLEVEL GR SBITMLEVEL[0] THEN                            000350
            BEGIN                                                       000360
         FOR I=SBITMLEVEL[0]+1 STEP 1 UNTIL 48 DO 
                ADJLEN[I] = 0;                                          000380
            END                                                         000390
                  IF LASTLEVEL LS SBITMLEVEL[0] AND TENCHAR EQ 1 THEN   000120
                    BEGIN                                               000130
                      I = SBITMLEVEL[0];                                000140
                      ADJLEN[I] = ADJLEN[I] + 1;                        000150
                    END                                                 000160
            SBITMDOMPTR[0] = RECHLDOM[0] - ADJLEN[RECHLLVL[1]];         000162
          FOR  I  =  0 STEP 1 UNTIL WORDLEN DO
            BEGIN 
             B<0,54> SBITMNAME[I+J]  =  B<6,54>RECNAME[I+K];
             B<54,6> SBITMNAME[I+J]  =  B<0,6> RECNAME[I+K+1];
            END 
             B<54,6> SBITMNAME[I+J-1] = O"55";
          IF B<0,6> SBITMNAME[I+J-1] EQ O"55" THEN
            BEGIN 
             SBITMNLENW[1] = SBITMNLENW[1] - 1; 
             SBITMWORD[I+J-1] = 0;
             WORDLEN = WORDLEN -1;
              FOR I = SBITMLEVEL[0] STEP -1 UNTIL 1 DO                  000220
                ADJLEN[I] = ADJLEN[I] + 1;                              000410
              TENCHAR = 1;                                              000111
            END 
               ELSE                                                     000190
                 TENCHAR = 0;                                           000200
          LASTLEVEL = SBITMLEVEL[0];                                    000270
             J = WORDLEN + J + 1;                                       001040
             IF RECHLOCCURSR[2] EQ 1 THEN                               001050
               BEGIN                                                    001060
          SBITMMAXOCC[J] = RECVALUE4[4];                                000120
          SBITMINOCCR[J] = RECVALUE3[4];
          SBITMDEPPTR[J] = RECDEPOBJ[4];                                000130
          SBITMDEPON[J] = RECDEPEND[4];                                 000140
                 J = J + 1;                                             001100
               END                                                      001110
      IF RECEDPTR[1] NQ 0                                                D2A164 
      THEN BEGIN                                                         D2A164 
           K = RECEDPTR[1];                                              D2A164 
           SBITMEDTPTR[2] = J;                                           D2A164 
           FOR I = 0 STEP 1 UNTIL B<55,5>RECMURAL[K] - 1 DO              D2A164 
                BEGIN              # MOVE MURAL                        # D2A164 
                SBITMMURAL[J] = RECMURAL[K+I];                           D2A164 
                J = J + 1;                                               D2A164 
                END                                                      D2A164 
           END                                                           D2A164 
             SBITMPRIPTR[0] = PUTLENG;                                  001220
             PUTLENG = J;                                               001230
             SBITMNXTPTR[0] = PUTLENG;                                  001240
          IF RECHLOCCURSR[2] EQ 1 THEN
             BEGIN
               IF RECHLITEMTYP[0] EQ QDGROUP THEN 
                 BEGIN
                   IF RECHLOCCURS[2] EQ 1 THEN
                      SBITMDATATYP[0] = REPINREP; 
                    ELSE
                       SBITMDATATYP[0] = REPGROUP;
                 END
                ELSE
                 BEGIN
                   IF RECHLOCCURS[2] EQ 1 THEN
                      SBITMDATATYP[0] = VECTORINREP;
                     ELSE 
                       SBITMDATATYP[0] = VECTOR;
                 END
               END
          RETURN; 
          END 
          PROC QDAREAMAP; 
            BEGIN 
           FOR I=0 STEP 1 UNTIL 94 DO 
               SBAREAWORD[I] = 0; 
    SBARTYPE[0] = SBAREA; 
      SBARMULTREC[0]=ARMULTREC[6];
        SBARMIPFLG [0] = ARMIPFLG [6];
             SBARNMLENW[1] = B<0,6> ARWORD[2];
             SBARPRIVPTR[1] = 0;
             SBARDUPS[1] = ARDUPS[6]; 
             SBARSORT[1] = ARSORT[6]; 
             SBARSEQOPT[1] = ARASCDSC[6]; 
             SBARTEMP[1] = ARTEMP[6]; 
             SBARCOLOPT[1] = ARCOLLATE[6];
          SBARRECPTR[1] = ARRECDPTR[7];                                 000140
           FOR I = 0 STEP 1 UNTIL SBARNMLENW[1] - 1 DO
            BEGIN 
              B<0,54> SBWORD[I+3] = B<6,54> ARWORD[I+2];
              B<54,6> SBWORD[I+3] = B<0,6> ARWORD[I +2 +1]; 
            END 
              B<54,6> SBWORD[I+2] = O"55";
          IF B<0,6> SBWORD[I+2] EQ O"55" THEN 
             BEGIN
               SBWORD[I+2] = 0; 
              SBARNMLENW[1] = SBARNMLENW[1] - 1;
             END
           I = 3 + SBARNMLENW[1]; 
          IF ARCOLLPTR[6] EQ 0 THEN 
             GOTO CHECKLOG; 
              SBARCOLLLENC[I] = ARCLITLEN[6];                           000250
          SBARCOLLENW[I] = ARCLITLENW[6]; 
           SBARCOLLPTR[2] = I;                                          000130
              I = I + 1;                                                000260
           J = ARCOLLPTR[6];
          FOR K=0 STEP 1 UNTIL ARCLITLENW[6] - 1 DO 
              SBWORD[I + K] = ARWORD[J + K];
           I = I + ARCLITLENW[6];                                       000360
        CHECKLOG: 
          IF ARLOGPTR[6]  EQ 0 THEN 
             GOTO  CHECKON; 
             J = ARLOGPTR[6]; 
             SBARLOGOPT[I] = ARLOGOPT[6]; 
             SBARLOGNMLEN[I] = B<0,6> ARWORD[J];
             SBARLOGPTR[2] = I; 
             I = I + 1; 
             FOR K = 0 STEP 1 UNTIL B<0,6> ARWORD[J] - 1 DO 
               BEGIN
                B<0,54> SBWORD[I + K] = B<6,54> ARWORD[J+K];
                B<54,6> SBWORD[I + K] = B<0,6> ARWORD[J+K+1]; 
               END
                B<54,6> SBWORD[I + K - 1] = O"55";
          IF B<0,6> SBWORD[I+K-1] EQ O"55" THEN 
             SBARLOGNMLEN[I-1] = SBARLOGNMLEN[I-1] -1;
          J = J + B<0,6>ARWORD[J];                                      000120
             I = I + SBARLOGNMLEN[I-1]; 
           FOR K=0 STEP 6 UNTIL 54 DO                                   000510
             BEGIN                                                      000520
            IF B<K,6>SBWORD[I-1] EQ O"55" THEN                          000400
                 BEGIN                                                  000540
              B<K,6>SBWORD[I-1] = 0;                                    000420
                 END                                                    000560
             END                                                        000570
          # MOVE REMAINDER OF LOG INFO  CY PW  ETC.                    #
             FOR K = 0 STEP 1 WHILE ARWORD[J + K] NQ 0 DO 
               SBWORD[I + K] = ARWORD[J + K]; 
             I = K + I + 1; 
         CHECKON: 
             IF ARONCALL[6] EQ 0 THEN 
                GOTO  CHECKSDAPTR;
             SBARONPTR[2] = I;
             J = ARONCALL[6]; 
           SBWORD[I] = ARONCWORD[J];
           I = I + 1; 
           FOR I = I STEP 1 WHILE ARONNEXT[J] DO
               BEGIN
               SBWORD[I] = ARONCWORD[J+1];
               J = J + 1; 
               END
CHECKSDAPTR:  
      IF ARSDANPTR[6] NQ 0 THEN 
           BEGIN
           J = ARSDANPTR[6];
           SBARSDAPTR[1] = I; 
           SBARSDAPRCNM[I] = ARPWORD[J];
           I = I + 1; 
           END
      FOR K = 0 STEP 1 UNTIL FITLENGTH - 1 DO 
           SBWORD[I+K] = ARWORD[8+K];       # MOVE THE FIT             #
      SBWORD[I] = 0;                        # CLEAR FIRST WORD OF FIT  #
      SBARFITPTR[2] = I;                    # FIT POINTER              #
      I = I + FITLENGTH;
      J = ARAR[0];
      IF J NQ 0 THEN
           BEGIN
           FOR K = 0 STEP 1 UNTIL 14 DO 
                BEGIN 
                SBWORD[I+K] = ARWORD[J+K];
                IF SBPV[I+K] EQ "          " THEN 
                     GOTO AFDBE;
                END 
AFDBE:  
           SBAR[0] = I; 
           I = I + K + 1; 
           END
           J=ARIN[0]; 
           IF J NQ 0 THEN 
               BEGIN
               FOR K=0 STEP 1 UNTIL 14 DO 
                   BEGIN
                   SBWORD[I+K]=ARWORD[J+K]; 
                   IF SBPV[I+K] EQ "         " THEN GOTO IFDBE; 
                   END
       IFDBE: 
               SBIN[0]=I; 
               I=I+K+1; 
               END
      IF ARLIBPTR[6] NQ 0 THEN
         BEGIN
         J=ARLIBPTR[6]; 
               FOR K=0 STEP 1 UNTIL 14 DO 
            BEGIN 
            SBWORD[I+K]=ARWORD[J+K];
                   IF SBPV[I+K] EQ "         " THEN GOTO LFDBE; 
            END 
LFDBE:  
         SBARLIBPTR[2]=I; 
         I=I+K+1; 
         END
            SBARNEXT[0] = I;
            RETURN; 
          END 
FINISHED:                                                               015320
      IF RELFLAG THEN              # IF RELATION FLAG IS SET           #015330
        QUDRTN4;                   # LOAD AND EXECUTE OVERLAY (3,4)    #015340
      QUDRTN5;                     # LOAD AND EXECUTE OVERLAY (3,5)    #015350
         PROC ZEROBUF(BUFNAME,NUMBWORDS); 
             BEGIN
            ARRAY BUFNAME[0];                                           000280
                ITEM FIRSTWORD  U(0,0,60);
             ITEM NUMBWORDS;
             FOR I = 0 STEP 1 UNTIL NUMBWORDS - 1 DO
                  FIRSTWORD[I] = 0 ;
             RETURN;
             END
         END
           TERM;
