*DECK EXHIBIT 
      PRGM DL30200;                # THIS IS 2,0 OVERLAY               # DL3A030
   BEGIN
      XREF
        BEGIN 
          ITEM CURLENG ;
          ITEM CURLENW; 
          ITEM DDLDIAG; 
          ITEM DDLMEM;
          ITEM EXDIAG;
          ITEM LBLPTR;
          ITEM LBLPTRS; 
          ITEM LEXICO;
          ITEM LEXICON; 
          ITEM LEXWD; 
          ITEM LEXWORD; 
          ITEM OLD65;        # LWA+1 OF OVERLAY JUST LOADED # 
          ITEM SCLFN; 
          ITEM SWITCHVCTR;
          ITEM SYNTBL;
          ITEM SYNTBLE; 
*IF DEF,DEBUG,2                                                          AT 
          ITEM TRACE; 
          ITEM TRACEM;
          PROC CLSEOUT; 
          PROC CLSESC;
          PROC CLSEIN ; 
          PROC DE$NMSC; 
          PROC DE$OPSC; 
          PROC DE$DISC; 
          PROC DDLINIT; 
          PROC DDLPRNT; 
           PROC EXREAD; 
          PROC DDLRTSC; 
          PROC DIAGDL;
          PROC STDNO; 
          PROC STDYES;
          PROC STD$START; 
          ARRAY CWORD [3];
            ITEM CURWORD C(0,0,10); 
        END 
      DEF  AREA         #  0#;     # EXHIBIT TYPE IS AREA              # AT 
      DEF  CONSTRAINT   # 11#;     # EXHIBIT TYPE IS CONSTRAINT        # AT 
      DEF  ITM          #  1#;     # EXHIBIT TYPE IS ITEM              # AT 
      DEF  RECORD       #  7#;     # EXHIBIT TYPE IS RECORD            # AU 
      DEF  RELATION     # 10#;     # EXHIBIT TYPE IS RELATION          # AT 
      DEF LN     #50#;
      DEF SZ #40# ; 
      DEF CWSZ  #13#;        # LENGTH OF SCHEMA CONTROL WORDS # 
      DEF MSZ   #256#;
      ITEM AVAILMEM;         # AVAILABLE MEMORY FOR WSA # 
      ITEM LL,LP; 
      ITEM LR;
      ITEM  SWANY ; 
      ITEM DITPTR;           # DIRECTORY INFORMATION TABLE POINTER     #
      ITEM  FSTENT,CURRENT,PTRIT,LIMIT; 
      ITEM CURITM ;          # CURRENT ITEM POINTER                    #
      ITEM I;                # SCRATCH ITEM.                           #
      ITEM J;                # SCRATCH ITEM.                           #
      ITEM K;                # SCRATCH ITEM.                           #
      ITEM M;                # SCRATCH ITEM.                           #
      ITEM L;                # SCRATCH ITEM.                           #
      ITEM N;                # SCRATCH ITEM.                           #
      ITEM ALLFLAG;          # INDICATES ALL NAMES OR CLAUSES TO BE EXH#
      ITEM ALLSFLAG ;                    # ALL ENTRIES TO BE EXHIBITED# 
      ITEM CLASFLAG;         # CLAUSE INDICATOR.                       #
      ITEM  COMFLAG B;             # TRUE = A COMMENT (/*) IS OPEN     #
                                   # FALSE = A COMMENT (*/) IS CLOSED  #
      ITEM DBPROCAD ;              #  WORD ADDRESS OF THE PROC TABLE   #
      ITEM EFLAG;            # EXHIBIT OPTION FLAG.                    #
      ITEM HASHL ;                 #  LENGTH OF SYMBOL TABLE           #
      ITEM NEXTENT;          # POINTER TO THE NEXT ENTRY.              #
      ITEM ONLYFLAG;         # IF 1 WE HAVE SET ONLYFLAG               #
      ITEM OUTWRD C(50);     # DDL EXHIBIT OUTPUT STORAGE              #
      ITEM RELPRADR;         # CONTAINS TEMPORARY WORD ADDRESSES FOR   #
                             # RELATION EXHIBIT PROCESSING.            #
      ITEM TYPE;             # CONTAINS TYPE OF AREA BEING EXHIBTED.   #
      ITEM BUFPTR;           # VARIABLE WORK BUFFER POINTER # 
      ITEM NAME C(240) ;
      ARRAY ; ITEM IBA$ U(0,0,3) ;
      DEF IBA #IBA$[0]# ; 
      ARRAY TEXTREC[6] S(1) ; 
        ITEM ONREC C(0,0,7) = 
         [" DELETE"," FIND  "," STORE "," GET   "," MODIFY"," INSERT",
          " REMOVE"] ;
      ARRAY TEXTITM[2] S(1);
        ITEM ONITM C(0,0,7)=
         [" STORE "," GET  "," MODIFY"] ; 
      DEF CHARVAL #1# ; 
      DEF BITVAL  #9# ; 
      DEF KEYVAL  #2# ; 
      DEF LOGVAL  #8# ; 
      ARRAY [16] S(3) ; 
        ITEM CLASSVAL C(0,0,22) =[
        2(" CHARACTER ") ,
        " DATABASE-KEY " ,
        2(" CHARACTER ") ,
        " 5","6","7", 
        " LOGICAL ",
        " BIT ",
        " DECIMAL FIXED ",
        " 11 ", 
        " DECIMAL FIXED ",
          " DECIMAL FLOAT ",
          " DECIMAL FIXED ",
        " DECIMAL FLOAT COMPLEX", 
        " LOGICAL " ]  ;
      ARRAY HASHWKBUF [99]; 
      BEGIN 
        ITEM HASHWRD U(0,0,60); 
      END 
      ARRAY SCRATCHBUF [SZ] S(1) ;
        BEGIN 
          ITEM SBITS U(0,0,60) ;
      ITEM SCRWRD C(0,0,30);
          ITEM AREANAME C(0,0,50) ; 
          ITEM NAMELEN       U(0,0,6);
        END 
      ARRAY SCBUF[195];;
      ARRAY DITSC[24] S(1); 
        BEGIN 
*CALL DITCOMSC
        END 
      BASED ARRAY WORKBUF [0] S(1);   # SCHEMA DIRECTORY WORK BUFFER #
        BEGIN 
          ITEM BITS          U(0,0,60); 
          ITEM BUFWRD        C(0,0,30); 
          ITEM ENTRYTYPE U(0,0,3) ; 
          ITEM ENTRYTYP U(0,0,60);
#**********************************************************************#
                                         # SCHEMA DIRECTORY TABLES #
*CALL SCHDECLS
*CALL SCDCDECLS 
*CALL SCRLHDDCL 
*CALL SCRLDBDCL 
#                                                                      # BE 
#     CONSTRAINT ENTRIES                                               # BE 
#                                                                      # BE 
*CALL SCCSHDDCL              CONSTRAINT HEADER DECLARATIONS              AS 
*CALL SCCSVRDCL              CONSTRAINT VARIABLE PART DECLARATIONS       AS 
                                                                         BE 
        END 
#**********************************************************************#
      SWITCH EXHIBITJMP 
                   ARCLAUSE,
                   ARNAME,
                   CHKEXH,
                   CKALL, 
                   CKONLY,
                   CSCLAUSE,       # OUTPUT CONSTRAINT BODY            # AT 
                   CSNAME,         # OUTPUT CONSTRAINT NAME            # AT 
                   DATACONTR, 
                   ENDEXH,
                   EXHANYNAME,
                   EXHANYCLAUSE,
                   EXHIBITSTRT, 
                   ITEMNAME,
                   ITEMCLAUSE,
                   RECDNAME,
                   RECDCLAUSE,
                   RELNAME, 
                   RELCLAUSE, 
                   SAVNAM,
                   SEARCH,
                   SEARCHCS,       # CHECK IF CONSTRAINTS PRESENT      # AT 
                   SEARCHCSTR,     # SEARCH FOR NEXT CONSTRAINT ENTRY #  AT 
                   SEARCHENTRY, 
                   SEARCHFST, 
                   SEARCHI, 
                   SEARCHNXT, 
                   SEARCHQI,
                   SEARCHREL, 
                   SEARCHRL,
                   SEARCHRI,
                   SETALL,
                   SETALLS, 
                   SETAREA, 
                   SETCLAUSES,
                   SETCSTR,        # SET SEARCH TYPE TO CONSTRAINT     # AT 
                   SETITEM, 
                   SETONLY, 
                   SETRECD, 
                   SETREL,
                   STRTSC;
   START:                # INITIALIZE ARRAY POINTERS                   #
      DDLDIAG = LOC(EXDIAG);
*IF DEF,DEBUG 
      TRACE = LOC(TRACEM);
*ENDIF
      LEXWD = LOC(LEXWORD); 
      LEXICO = LOC(LEXICON);
      SYNTBL = LOC(SYNTBLE);
      LBLPTR = LOC(LBLPTRS);
*IF DEF,DEBUG 
      TRACE = LOC(TRACEM);
*ENDIF
      SWITCHVCTR = LOC(EXHIBITJMP); 
      DDLINIT;
#***  HERE WE MAY INSERT THE TEST CASE GENERATING CODE  ***            #
      STD$START;
  ARCLAUSE:  #  ***  A R C L A U S E        ***#
 #********************************************************************# 
#  EXHIBIT CLAUSES OF AN AREA ENTRY                                    #
#**********************************************************************#
      IF SCAREAENTRYL[0] GR SZ THEN 
        BEGIN 
          K=SCAREAENTRYL[0] ; 
          CHECKBUF(K);
          EXREAD(WORKBUF,K,CURRENT) ; 
        END 
ARCALL:   #    ***  A R C A L L   ***                                  #
#**********************************************************************#
#   EXHIBIT THE CALL CLAUSE IF IT EXISTS                               #
#            ----   C A L L  PROC E R R O R                            #
#                                  B E F O R E                         #
#                                  A F T E R                           #
#                                                                      #
#            ----      C L O S E                                       #
#                      O P E N     U P D A T E                         #
#                                  R E T R I E V A L                   #
      IF SCHARCALLPTR[0] NQ 0 THEN
        BEGIN                      # CALL CLAUSES SPECIFIED # 
          J = SCHARCALLPTR[0];
LOOPC:    IBA = SCAREAONBFAF[J] ; 
          CALLON ;
          IF SCARCALLOPN[J] THEN
            OUTTEXT(" OPEN", 5);
          IF B<0,3>SCARONUPRTOP[J] NQ 0 THEN
            OUTTEXT(" RETRIEVAL",10); 
          IF B<3,3>SCARONUPRTOP[J] NQ 0 THEN
            OUTTEXT(" UPDATE",7); 
          IF SCARCALLCLS[J] THEN
            OUTTEXT(" CLOSE",6);
          OUTSUB ;
          IF SCAREANEXTON[J] THEN 
            BEGIN                  # MORE CALL CLAUSES PRESENT #
              J = J + 1;
              GOTO LOOPC; 
            END 
        END 
ARPRIV:   #      ***   A R P R I V      ***                            #
#**********************************************************************#
#   EXHIBIT THE ACCESS-CONTROL CLAUSE IF ANY                           #
#            ---- A C C E S S - C O N T R O L  R E T R I E V A L       #
#                                               U P D A T E            #
#           ----  IS  P R O C E D U R E  PROC-NAME    OR               #
#                                        "LITERAL"  .....              #
      IF SCAREAPRVPTR[0] NQ 0 THEN
        BEGIN                      # ACCESS-CONTROL ENTRIES PRESENT # 
          J = SCAREAPRVPTR[0];
 LOOP2:   C<L,19>OUTWRD = "ACCESS-CONTROL FOR ";
          L = L + 19; 
          IF B<0,3>SCAREALOCKOP[J] NQ 0 THEN
            OUTTEXT("RETRIEVAL ",10); 
          IF B<3,3>SCAREALOCKOP[J] NQ 0 THEN
            OUTTEXT("UPDATE ",7); 
          OUTTEXT("IS ",3); 
          N = SCHNXPRIVPTR[J];     # NEXT ACCESS-CONTROL ENTRY #
          PRIV;                    # ROUTINE TO OUTPUT LIT/DBP #
          IF N NQ 0 THEN
            BEGIN                  # MORE ACCESS-CONTROL ENTRIES #
              OUTSUB; 
              GOTO LOOP2; 
            END 
        END 
      C<L,1>OUTWRD = "." ;
      OUTENT ;
      STDNO;
  ARNAME:        #       ***    A R N A M E    ***                     #
#**********************************************************************#
#   MOVES THE AREA NAME INTO  THE OUTPUT BUFFER ALONG WITH THE         #
#   CORRESPONDING DDL SYNTAX, AND THEN PRINTS IT OUT.                  #
#**********************************************************************#
      IF COMFLAG THEN BEGIN 
         C<L,2>OUTWRD = "*/" ;
         OUTENT ; 
         COMFLAG = FALSE ;
        END 
#            ----   A R E A        AREANAME                            #
      C<L,5>OUTWRD = "AREA " ;
      L=L+5 ; 
      I = SCHAREANAMEC[0] ; 
      C<L,I>OUTWRD = C<0,I>SCHAREANAM30[SCARNAMEPTR[0]];
      IF CLASFLAG EQ 1 THEN 
        BEGIN 
          OUTSUB ;
          STDNO  ;
        END 
        OUTENT ;
      STDYES; 
  CHKEXH:        #       ***    C H K E X H      ***                   #
#**********************************************************************#
#   CHECKS IF EFLAG IS SET, WHICH INDICATES THAT AT LEAST ONE OF       #
#   EXHIBITS OPTIONS ARE SPECIFIED IN EXHIBITS SOURCE INPUT. IF EFLAG  #
#   IS SET RETURN IS TO STDYES, ELSE STDNO.                            #
#**********************************************************************#
      IF EFLAG EQ 1 THEN
        STDYES;     # NEED EFLAG = 0 SOMETIME BEFORE LOOPING# 
      STDNO;
  CKALL:         #     ***     C K A L L     ***                       #
#***************************************************************# 
#    CHECKS IF THE ALL FLAG IS SET ANE IF SO RETURNS TO SEARCH ROUTINE #
#   FOR NEXT ENTRY. PUTS NEXT ENTRY INTO THE WORKBUF.                #
#**********************************************************************#
      IF ALLFLAG EQ 1 THEN
        BEGIN 
          IF TYPE EQ RELATION               # IF RELATIONS             # AT 
             OR TYPE EQ CONSTRAINT          # OR CONSTRAINTS           # AT 
          THEN STDYES;                                                   AT 
          IF NEXTENT EQ 0 THEN STDNO ;
          EXREAD(WORKBUF,SZ,NEXTENT) ;
          CURRENT = NEXTENT ; 
          PTRIT=0;
          STDYES; 
       END
          STDNO;
  CKONLY:  #  ***  C K O N L Y    *** # 
 #********************************************************************# 
#   CHECKS THE ONLY FLAG IF SET RETURN TO STDYES ELSE TO STDNO         #
#**********************************************************************#
      IF ONLYFLAG EQ 1 THEN STDYES ;
                  ELSE STDNO  ; 
                                                                         BB 
   CSCLAUSE:       # ***     C S C L A U S E    ***                    # AV 
#**********************************************************************# AU 
#     OUTPUTS THE ASSOCIATED CONSTRAINT DBI"S APPROPRIATELY QUALIFIED  # AX 
#     BY THE RECORD NAME. RETURN IS TO STDNO.                          # AX 
#                                                                      # AX 
#**********************************************************************# AX 
                                                                         BB 
      FOR J = 0 STEP 1 UNTIL 1 DO                # GENERATE BODY       # AY 
          BEGIN                                                          AY 
          K = SCCSNAMPTR[0] + SCCSNAMLENW[0] + J;                        AY 
          IF SCCSCONKEY[K]                       # IF CONCATENATED KEY # AY 
          THEN OUTITM( SCCSKEYWA[K], 1);         # KEY NAME            # AY 
          ELSE BEGIN                                                     AY 
               EXREAD( SCRATCHBUF, SZ, SCCSKEYWA[K]); # READ ITEM ENTRY# AZ 
               OUTITM( B<3,21>SBITS[2], 0);           # DBI NAME       # BA 
               OUTTEXT( " IN ", 4);                                      BA 
               OUTREC( RELPRADR);                # QUALIFIER NAME      # AY 
               END                                                       AY 
          IF J NQ 1                                                      AZ 
          THEN BEGIN                                                     BC 
               OUTSUB;                                                   BF 
               L = L - 1;                                                BF 
               C<L,7>OUTWRD = "EQUALS ";                                 BF 
               END                                                       BC 
           OUTSUB;                                                       BF 
          END                                                            AY 
      C<5,1>OUTWRD = ".";                        # TERMINATING PERIOD  # BC 
      OUTENT;                                                            AY 
      STDNO;                                                             AU 
                                                                         AT 
   CSNAME:         #   ***    C S N A M E    ***                       # AT 
#**********************************************************************# AT 
#     MOVES THE CONSTRAINT NAME INTO THE OUTPUT BUFFER ALONG WITH      # AT 
#     THE CORRESPONDING DDL SYNTAX, AND THEN PRINTS IT OUT.            # AT 
#                                                                      # AT 
#**********************************************************************# AT 
                                                                         AT 
      IF COMFLAG                       # IF COMMENT FLAG STILL ON      # AT 
      THEN BEGIN                                                         AT 
           C<L,2>OUTWRD = "*/";        # END COMMENT                   # AT 
           OUTENT;                                                       AT 
           COMFLAG = FALSE;                                              AT 
           END                                                           AT 
      C<L,11>OUTWRD = "CONSTRAINT ";                                     AT 
      L = L + 11;                                                        AT 
      I = SCCSNAMLENC[0];              # LENGTH OF CONSTRAINT NAME     # AT 
      C<L,I>OUTWRD = C<0,I>SCCSTRNAM30[SCCSNAMPTR[0]];                   AU 
      IF CLASFLAG EQ 1                                                   AT 
      THEN BEGIN                                                         AT 
           OUTSUB;                     # PRINT ENTRY                   # AT 
           STDNO;                      # RETURN                        # AT 
           END                                                           AT 
      OUTENT;                          # PRINT ENTY                    # AT 
      STDYES;                                                            AT 
                                                                         AT 
DATACONTR:       #   ***  D A T A C O N T R   ***                      #
#**********************************************************************#
#  EXHIBIT ALL OF THE DATA CONTROL ENTRY.IT CHECKS IN CONTROL WORDS IF #
#  THIS ENTRY EXISTS.IF NO,RETURNS STDNO.IF YES,EXHIBIT PROC LIB NAME  #
#  FROM THE CONTROL WORDS,THEN SEARCH THE DIRECTORY FOR AREAS.FOR EACH #
#  AREA,EXHIBIT THE AREANAME,FETCH ITS DATACONTROL SUB.ENTRY,EXHIBIT IT#
#  AT END,RETURNS STDNO                                                #
#**********************************************************************#
      EXREAD(WORKBUF,CWSZ,0) ;
      IF SCCWDCADDR[DITPTR] EQ 0 THEN 
        STDNO;
      DBPROCAD = SCCWDBPWRDAR[DITPTR];
      OUTTEXT(" DATA CONTROL",13); #      D A T A  C O N T R O L       #
      OUTENT ;
      C<L,1>OUTWRD = "."; 
      OUTENT; 
      NEXTENT = SCCWFRSTAREA[DITPTR]; 
DCLP: IF NEXTENT EQ 0 THEN  STDNO ; 
      EXREAD(WORKBUF,SZ,NEXTENT); 
      CURRENT = NEXTENT ; 
      IF ENTRYTYPE[0] NQ AREA THEN STDNO ;
      NEXTENT = SCARNXTAREA[0]; 
      OUTTEXT("AREA ",5) ;              # A R E A  AREANAME            #
      K = SCHAREANAMEC[0] ; 
      C<L,K>OUTWRD = C<0,K>SCHAREANAM30[SCARNAMEPTR[0]];
      L=L+K ; 
      OUTSUB; 
      J = SCAREADCNTLA[0] ; 
      K = SCAREADCLENG[0] ; 
      CHECKBUF(K);
      EXREAD(WORKBUF,K,J)  ;
      N = J;
      J = SCDCCDTBLPTR[0];
      IF SCDCCDSYSFLG[0] OR J NQ 0 THEN 
        BEGIN         #     ***    COMP/DECOMP CLAUSE    ***           #
#**********************************************************************#
#  ----  F O R    C O M P R E S S I O N     D E C O M P R E S S I O N  #
#                                                                      #
#                 U S E      S Y S T E M                               #
#                            P R O C E D U R E    PROCNAME             #
        IF SCDCCDSYSFLG[0] THEN 
          BEGIN 
          OUTTEXT("FOR COMPRESSION DECOMPRESSION USE SYSTEM ",41);
          OUTSUB; 
          END 
        IF J NQ 0 THEN
          BEGIN 
          I = J;
          FOR J = J STEP 1 UNTIL (I + SCDCCDTBLENG[0]) - 1 DO 
            BEGIN 
            OUTTEXT("FOR ",4);
            IF SCDCCDCMPFLG[J] THEN 
              OUTTEXT("COMPRESSION ",12); 
            IF SCDCCDDCMPFG[J] THEN 
              OUTTEXT("DECOMPRESSION ",14); 
            OUTTEXT("USE PROCEDURE ",14); 
            C<0,7>NAME = C<0,7>SCDCCDDBPNME[J]; 
            OUTNAME(7); 
            OUTSUB; 
            END 
          END 
        END 
      J= SCDCALTRKYPT[0]  ; 
      IF J NQ 0 THEN
        BEGIN                      #  *** ALTERNATE KEY CLAUSE  ***    #
#**********************************************************************#
#            ----   K E Y  A L T E R N A T E  DATANAME                 #
#            ----          U S I N G  PROCNAME                         #
#            ----          D U P L I C A T E S  I N D E X E D          #
#                                               F I R S T              #
#                                               N O T                  #
KEYLP:    OUTTEXT("KEY ",4) ; 
      IF SCDCKEYCONCT[J+1] THEN 
        OUTTEXT("ID ",3); 
      IF NOT SCDCKEYPRI[J+1] AND NOT SCDCKEYSORT[J+1] THEN
        OUTTEXT("ALTERNATE ",10); 
          IF SCDCKEYIMBED[J+1] THEN 
          BEGIN 
            IF SCDCKEYCONCT[J+1] THEN 
            BEGIN 
              K = N + J;                # ADDRESS OF CONCATENATED KEY  #
                                       # ENTRY.                        #
              OUTITM(K,1);
              OUTTEXT(" < ",3); 
              M = J + 3 + SCDCKEYCNNMW[J+2];
              FOR I = SCDCKEYCNITN[J+2] STEP -1 UNTIL 1 DO
                BEGIN 
                K = SCDCKEYCNDNA[M];
                OUTITM(K,0);
                IF SCDCKEYCNQAL[M] THEN 
                BEGIN 
                  OUTTEXT(" OF ",4);
                  K = SCDCRCENTRYA[J] ; 
                  OUTREC(K);
                END 
                IF I GR 1 THEN
                  OUTTEXT(",",1); 
                M = M + 1;
                END 
              OUTTEXT(" > ",3); 
            END 
            ELSE BEGIN
            K=SCDCKEYDNADR[J+2] ; 
            OUTITM(K,0);
            K = SCDCRCENTRYA[J];   # RECORD ADDRESS # 
            OUTTEXT(" OF ",4);
            OUTREC(K);             # OUTPUT RECORD NAME # 
            END 
          END 
          ELSE BEGIN
            LL= SCDCKEYDNLEN[J+2] ; 
            IF (L+LL) GR LN THEN OUTLINE ;
            C<L,LL>OUTWRD = C<0,LL>SCDCKEYDNME[J+3] ; 
            L=L+LL; 
            IF SCDCKEYDNNXT[J+2] THEN 
            BEGIN 
              LL=SCDCKEYRQALL[J+2] ;
              I = SCDCKEYRQALP[J+2] ; 
              IF (L+LL+4) GR LN THEN OUTLINE ;
              OUTTEXT(" OF ",4) ; 
              C<L,LL>OUTWRD = C<0,LL>SCDCKEYQALNM[I] ;
              L=L+LL ;
            END 
          END 
          IF SCDCSDAPRCN[0] NQ 0 THEN 
          BEGIN 
            OUTTEXT(" USING ",7) ;
            C<0,7>NAME = SCDCSDAPRCN[0];
            OUTNAME(7) ;
          END 
          IF SCDCKEYDUPS[J+1] THEN OUTTEXT (" DUPLICATES ",12) ;
          IF SCDCKEYINDEX[J+1] THEN OUTTEXT("INDEXED ",8) ; 
          IF SCDCKEYFIRST[J+1] THEN OUTTEXT("FIRST ",6) ; 
          IF SCDCKEYNOT[J+1]   THEN OUTTEXT("NOT ",4) ; 
          OUTSUB; 
        IF SCDCKEYNITM[J+1] NQ 0 THEN 
          BEGIN 
            J = J + SCDCKEYNITM[J+1]; 
            GOTO KEYLP; 
          END 
        END 
      J= SCDCRECCDPTR[0] ;
      IF J NQ 0 AND NOT SCDCRECCDFLG[0] THEN
        BEGIN                      #  ***  RECORD CODE CLAUSE          #
#**********************************************************************#
#            ----  R E C O R D  C O D E  B Y  DATANAME                 #
#                                        P R O C E D U R E  PROCNAME   #
#                                                                      #
#            ----  V A L U E  RECORDNAME I S LITERAL, V A L U E  ...   #
#                                            INTEGER                   #
          OUTTEXT("RECORD CODE ",12) ;
          IF SCDCRCDETYP[J] THEN
          BEGIN 
            OUTTEXT("PROCEDURE ",10) ;
            C<0,7>NAME = C<0,7>SCDCRCDEPROC[J];   # STORE PROC NAME # 
            OUTNAME(7) ;
            OUTLINE ; 
            I = J+1 ; 
RECLP1:     OUTTEXT(" VALUE ",7); 
            K = SCDCRCDERECA[I] ; 
            OUTREC(K) ; 
            OUTTEXT(" IS ",4) ; 
            K = SCDCRCDEINTV[I] ; 
            OUTINT(K) ; 
            IF SCDCRCDENEXT[I] THEN 
            BEGIN 
              OUTTEXT(",",1); 
              OUTLINE ; 
              I=I+1 ; 
              GOTO RECLP1 ; 
            END 
          END 
          ELSE BEGIN
            OUTTEXT("BY",2);                                             DL3A033
            K = SCDCRCDEITMP[J];                                         DL3A033
            OUTITM(K,0);
            OUTTEXT(" OF ",4);                                           DL3A033
            K = RELPRADR;          # RECORD WORD ADDRESS #               DL3A033
            OUTREC(K);               # PRINT RECORD NAME #               DL3A033
            OUTLINE;                                                     DL3A033
            I = J + 2;
RECLP2:     OUTTEXT(" VALUE ",7) ;
            K= SCDCRCDERECA[I] ;
            OUTREC(K) ; 
            OUTTEXT(" IS ",4) ; 
            K = J+SCDCRCDELITP[I] ; 
            LL= SCDCRCDELITL[I] ; 
            IF(L+LL+3) GR LN THEN OUTLINE ; 
            OUTTEXT("""",1) ; 
            C<0,LL>NAME  = C<0,LL>BUFWRD [K] ;
            OUTLIT(LL); 
            OUTTEXT("""",1) ; 
            IF SCDCRCDENEXT[I] THEN 
            BEGIN 
              IF (L+1) GR LN THEN OUTLINE ; 
              OUTTEXT(",",1); 
              OUTLINE ; 
              I=I+1 ; 
              GOTO RECLP2 ; 
            END 
          END 
          OUTSUB ;
        END 
      IF SCDCSEQOPT[0] NQ 0 THEN
        BEGIN                      #  *** SEQUENCE CLAUSE   ***        #
#**********************************************************************#
#            ----   S E Q U E N C E   C O B O L                        #
#                                     A S C I I                        #
          OUTTEXT("SEQUENCE ",9) ;
          IF SCDCSEQCOBOL[0] THEN OUTTEXT("COBOL ",6) ; 
          IF SCDCSEQASCII[0] THEN OUTTEXT("ASCII ",6) ; 
          OUTSUB ;
        END 
      OUTTEXT(".",1); 
      OUTENT ;
      GOTO DCLP ; 
ENDEXH:     #     ***     E N D E X H     ***                          #
#**********************************************************************#
#    TERMINATES EXHIBIT RUN.                                           #
#**********************************************************************#
      CLSESC; 
      CLSEIN  ; 
      CLSEOUT;
      STOP; 
  
  EXHIBITSTRT:   #       ***    E X H I B I T S T R T    ***           #
#**********************************************************************#
#   OPENS THE SCHEMA FILE AND STORES THE 4 SCHEMA CONTROL WORDS INTO   #
#   DACTL. THEN MOVES THE HASH INDEX FROM THE SCHEMA FILE TO A WORKING #
#   STORAGE AREA AND IN ADDITION STORES THE ADDRESS OF WORKING STORAGE #
#   WHERE THE HASH INDEX IS STORED AND ITS LENGTH.                     #
#**********************************************************************#
      CLEARWRD; 
      P<WORKBUF> = OLD65;          # SET WORK BUFFER TO FIRST AVAILABLE#
                                   # WORD IN MEMORY.                   #
      AVAILMEM = DDLMEM - OLD65;   # AVAILABLE MEMORY FOR WORK BUFFER # 
      I = 0;
      IF SCLFN EQ 0 THEN
        STDNO;
      B<0,42>I = B<0,42>SCLFN;
      DE$OPSC(I,DITSC,SCBUF,195); 
      IF SCCWSCHNAME[DITPTR] EQ 0 THEN
        STDNO;
      NEXTENT = 0 ; 
      CHECKBUF(CWSZ); 
      EXREAD(WORKBUF,CWSZ,NEXTENT) ;  # READ IN CONTROL WORDS         # 
      C<1,2>OUTWRD = "/*" ; 
      OUTENT ;
      C<L,16>OUTWRD = " EXHIBIT SCHEMA " ;
      L=L+16; 
      C<0,30>NAME = SCCWSCHNAM30[DITPTR]; 
      OUTNAME(30) ; 
      OUTENT ;
      C<L,23>OUTWRD = " TIME,DATE OF CREATION "  ;
      L =L+23 ; 
      C<L,5>OUTWRD = C<0,5>SCCWSCTMEDTE[DITPTR];
      L=L+5;
      C<L,2>OUTWRD = "  " ; 
      L=L+2 ; 
      C<L,5>OUTWRD = C<5,5>SCCWSCTMEDTE[DITPTR];
      OUTENT ;
      C<L,35>OUTWRD= "***********************************" ;
      OUTENT ;
      C<L,2>OUTWRD = "*/" ; 
      OUTENT ;
      LIMIT = SCCWDCADDR[0];
      STDYES; 
EXHANYNAME:      #   *** E X H A N Y N A M E        ***                #
#**********************************************************************#
#    EXHIBIT THE NAME OF AN ENTRY EITHER AREA,RECORD,ITEM              #
#**********************************************************************#
  SWITCH ANYNAM  ARNAME,RECDNAME,ITEMNAME,RELNAME;
      GOTO ANYNAM[SWANY] ;
EXHANYCLAUSE:    #   *** E X H A N Y C L A U S E    ***                #
#**********************************************************************#
#    EXHIBIT CLAUSES OF AN ENTRY EITHER  AREA,RECORD,ITEM              #
#**********************************************************************#
  SWITCH ANYCLA  ARCLAUSE,RECDCLAUSE,ITEMCLAUSE,RELCLAUSE;
      GOTO ANYCLA[SWANY] ;
  ITEMNAME:  #  *** I T E M N A M E  *** #
 #********************************************************************# 
#   EXHIBIT LEVEL AND NAME OF AN ITEM ENTRY                            #
#**********************************************************************#
      IF COMFLAG THEN BEGIN 
         C<L,2>OUTWRD = "*/" ;
         OUTENT ; 
         COMFLAG = FALSE ;
        END 
#                   LEVEL  ITEMNAME                                    #
      K=SCITEMLEVEL[0] ;
      OUTINT(K) ; 
      I = SCITMNAMLENC[0];
      C<L,I>OUTWRD = C<0,I>SCITMNAM30[SCITMNAMEPTR[0]]; 
      IF CLASFLAG EQ 1 THEN 
        BEGIN 
          OUTSUB ;
          STDNO  ;
        END 
      OUTENT ;
      STDYES ;
  ITEMCLAUSE:  #  ***   I T E M C L A U S E    ***# 
 #********************************************************************# 
#   EXHIBIT CLAUSES OF AN ITEM ENTRY                                   #
#**********************************************************************#
      IF SCITMENTRYLG[0] GR SZ THEN 
        BEGIN 
          K=SCITMENTRYLG[0] ; 
          CHECKBUF(K);
          EXREAD(WORKBUF,K,CURITM) ;
        END 
      IF SCITEMTYPE[0] THEN         #   ***   TYPE CLAUSE   ***        #
#**********************************************************************#
#            ----   T Y P E  C H A R A C T E R                         #
#                            D E C I M A L  F I X E D                  #
#                            D E C I M A L  F L O A T                  #
#                            D E C I M A L  F L O A T  C O M P L E X   #
#                                                                      #
#            ----       INTEGER,INTEGER                                #
        BEGIN 
          C<L,4>OUTWRD = "TYPE" ; 
          L=L+4 ; 
          I = SCITEMCLASS[0]; 
          C<L,22>OUTWRD = CLASSVAL [I] ;
          IF I LQ CHARVAL 
             OR I EQ BITVAL 
             THEN  BEGIN
                     L = L+10;
                     K = SCITEMSIZE[0]; 
                     IF K GR 1 THEN 
                     OUTINT(K); 
                   END
             ELSE IF I EQ KEYVAL  OR  I EQ LOGVAL 
                 THEN BEGIN 
                   OUTSUB;
                   GOTO LABTYP ;
                 END
          ELSE IF SCITMINT1[0] NQ 0 THEN
          BEGIN 
            L=L+22 ;
            OUTTEXT(SCITMINT1[0],2);
            IF SCITMINT2[0] NQ 0 THEN 
            BEGIN 
              OUTTEXT(",",1) ;
              IF NOT SCITEMPTLEFT[0] THEN 
                OUTTEXT("-",1); 
              OUTTEXT(SCITMINT2[0],2);
            END 
          END 
          OUTSUB; 
          GOTO LABTYP   ; 
        END 
        ELSE IF SCITMPICLITP[0] NQ 0
#            ----   P I C T U R E  " PICTURESPEC "                     #
          THEN BEGIN
            OUTTEXT("PICTURE """,9) ; 
            J = SCITMPICLITP[0];
            LL = SCITMPICLEN[0]*10; 
            C<0,LL>NAME =C<0,LL>BUFWRD[J] ; 
            OUTNAME(LL) ; 
            OUTTEXT("""",1) ; 
            OUTSUB; 
          END 
 LABTYP:  
      IF SCITMINTVAL[0] NQ 0 OR 
                SCITMDEPORDL[0] NQ 0 THEN    #  ***  OCCURS CLAUSE  ***#
#**********************************************************************#
#            ----   O C C U R S   INTEGER                              #
#                                 DBINAME                              #
        BEGIN 
         C<L,7> OUTWRD = "OCCURS " ;
         L=L+7 ;
          IF SCITMDIMOCC[0] THEN
            OUTDBI(SCITMDEPORDL[0]);     # OUTPUT DBI NAME #
          ELSE
            OUTINT(SCITMINTVAL[0]);      # OUTPUT INTERGER VALUE #
         OUTSUB ; 
        END 
      J = SCITMATVTP[0];           #   ***  RESULT CLAUSE  ***         #
#**********************************************************************#
#            ----   A C T U A L    R E S U L T  PROC                   #
#                   V I R T U A L                                      #
      IF NOT SCITMRESSCRF[0] THEN 
      BEGIN 
      IF J NQ 0 THEN
        BEGIN 
          IF SCITMAVRESLT[J] THEN C<L,15>OUTWRD = "VIRTUAL RESULT ";
                             ELSE C<L,15>OUTWRD = "ACTUAL  RESULT " ; 
          L = L+15 ;
        C<0,7>NAME=C<0,7>SCITEMRESULT[J] ;
        OUTNAME(7) ;
        END 
      END 
      OUTSUB; 
      J = SCITEMCHECKS[0];
      IF J NQ 0 THEN               #   ***   CHECK CLAUSE   ***        #
#**********************************************************************#
#            ----   C H E C K  P I C T U R E                           #
#                              N O N N U L L                           #
#                              PROC                                    #
#                              V A L U E  N O T  "LIT" , "LIT",...     #
#                                                    T H R U           #
        BEGIN 
          OUTTEXT("CHECK ",6) ; 
          IF SCITMCKPIC[J] THEN OUTTEXT("PICTURE ",8);
          IF SCITMCKDBP[J] THEN 
             BEGIN
               C<0,7>NAME = C<0,7>SCITMCKPROC[J]; 
               OUTNAME(7);
               OUTLINE ;
             END
          IF SCITMCKVALUE[J] THEN 
          BEGIN 
            OUTTEXT("VALUE ",6) ; 
            IF SCITMCKNOT[J] THEN OUTTEXT("NOT ",4);
            K=SCITMCKNLIT[J+1] ;
            M=20 ;
            N= J+1; 
            LP=J+SCITMCKLITP[N] ; 
            IF SCITMCKEXPTR[0] EQ 0 THEN
            BEGIN 
                FOR I= 1 STEP 1 UNTIL K DO
                BEGIN 
                  IF I EQ 1 THEN GOTO FIRST ; 
                  IF B<M,1>SCITMCKLIT[N] EQ 1 THEN
                   OUTTEXT("THRU ",5) ; 
                   ELSE  OUTTEXT(",",1);
FIRST:           LL=B<(M+1),19>SCITMCKLIT[N] ;
                 IF LL GQ 240 THEN TEST ; 
                 C<0,LL>NAME = C<0,LL>BUFWRD[LP] ;
              IF (L+LL+2) GR LN THEN OUTLINE ;
        IF SCITEMCLASS[1] LQ 1 THEN 
          BEGIN 
            OUTTEXT("""",1);
            OUTLIT(LL); 
            OUTTEXT("""",1);
          END 
        ELSE
          OUTNAME(LL);
                 LR=LL/10;
                 IF (LL-LR*10) GR 0 THEN  LR=LR+1 ; 
                 LP=LP+LR;
                END 
            END ELSE BEGIN
                N = SCITMCKEXPTR[0];
CKLOOP:       LP = N+1; 
              LL= SCITMCKEXLNC[N] ; 
              IF (LL GQ 240) THEN LL=240 ;
              IF (L+LL+2) GR LN THEN OUTLINE ;
                IF SCITEMCLASS[0] LQ 1 THEN 
               OUTTEXT("""",1) ;
              C<0,LL>NAME = C<0,LL>BUFWRD[LP] ; 
              OUTLIT(LL); 
                IF SCITEMCLASS[0] LQ 1 THEN 
               OUTTEXT("""",1) ;
                IF SCITMCKEXNXL[N] NQ 0 THEN
              BEGIN 
                  N =N + SCITMCKEXNXL[N]; 
                 IF SCITMCKEXTHR[N] THEN OUTTEXT(" THRU ",6); 
                                    ELSE OUTTEXT(" , ",3) ; 
                GOTO CKLOOP ; 
              END 
            END 
              END 
             OUTSUB ; 
        END 
      J = SCITMENCDPTR[0];
      IF J NQ 0 THEN               #    *** ENCODE DECODE CLAUSE ***   #
#**********************************************************************#
#            ----   D E C O D I N G  A L W A Y S  C A L L  PROC        #
#                   E N C O D I N G                                    #
        BEGIN 
LOOPENC:  IF SCITEMENCODE[J] EQ 1 THEN C<L,9>OUTWRD = "DECODING " ; 
                                  ELSE C<L,9>OUTWRD = "ENCODING " ; 
          L =L+9 ;
          IF SCITEMALWAYS[J] THEN OUTTEXT("ALWAYS ",7) ;
          OUTTEXT("CALL ",5) ;
          C<0,7>NAME =C<0,7>SCITEMCODER[J] ;
          OUTNAME(7) ;
          OUTSUB ;
          IF SCITEMCNEXT[J] THEN
            BEGIN 
              J=J+1 ; 
              GOTO LOOPENC; 
            END 
        END 
      J = SCITEMONPTR[0]; 
      IF J NQ 0 THEN               #   ***  CALL  CLAUSE          ***  #
#**********************************************************************#
#            ----   C A L L  PROC  E R R O R    S T O R E              #
#                                  B E F O R E  G E T                  #
#                                  A F T E R    M O D I F Y            #
        BEGIN 
LOOPITC:  IBA = SCITEMONBFAF[J] ; 
          CALLON ;
          IF SCITEMONOPTS[J] NQ 0 THEN
            BEGIN 
              FOR K=0 STEP 1 UNTIL 2 DO 
                IF B<K,1>SCITEMONOPTS[J] EQ 1 THEN OUTTEXT(ONITM[K],7); 
            END 
            OUTSUB ;
          IF SCITEMNEXTON[J] THEN 
            BEGIN 
              J=J+1 ; 
              GOTO LOOPITC ;
            END 
        END 
      C<L,1>OUTWRD = "." ;
      OUTENT ;
      STDNO ; 
  RECDNAME:   #     ***     R E C D N A M E     ***                   # 
#*********************************************************************# 
#   MOVES THE RECORD NAME INTO THE OUTWRD BUFFER ALONG WITH DDL     # 
#   SYNTAX THEN PRINTS THEM OUT.                                    # 
#*******************************************************************# 
      IF COMFLAG THEN BEGIN 
         C<L,2>OUTWRD = "*/" ;
         OUTENT ; 
         COMFLAG = FALSE ;
        END 
#            ----   R E C O R D    RECORDNAME                          #
      C<L,7>OUTWRD = "RECORD " ;
      L=L+7 ; 
      I = SCRNAMELENC[0] ;
      C<L,I>OUTWRD = C<0,I>SCRECNAM30[SCRECNAMEPTR[0]]; 
      IF CLASFLAG EQ 1 THEN 
        BEGIN 
          OUTSUB ;
          STDNO  ;
        END 
      OUTENT ;
      STDYES ;
 RECDCLAUSE:  #   ***  R E C D C L A U S E   ***  # 
 #********************************************************************# 
#   EXHIBIT CLAUSES OF A RECORD ENTRY                                  #
#**********************************************************************#
      IF SCRECDITMPTR[0] GR SZ THEN 
        BEGIN 
          K = SCRECDITMPTR[0];     # RECORD ENTRY LENGTH #
          CHECKBUF(K);             # CHECK BUFFER SPACE # 
          EXREAD(WORKBUF,K,CURRENT) ; 
        END 
      J = SCRWITHINA1[0];          # AREA WORD ADDRESS #
       IF J NQ 0 THEN 
         BEGIN                     #   ***  WITHIN CLAUSE  ***         #
#**********************************************************************#
#            ----  W I T H I N   AREANAME                              #
          OUTTEXT("WITHIN ",7); 
          OUTARN(J);
      END 
          OUTSUB; 
      J = SCRECONLIST[0]; 
       IF J NQ 0 THEN 
         BEGIN                     #   ***  CALL ON CLAUSE  ***        #
#**********************************************************************#
#            ----   C A L L  PROC  E R R O R    D E L E T E            #
#                                  B E F O R E  F I N D                #
#                                  A F T E R    S T O R E              #
#                                               G E T                  #
#                                               M O D I F Y            #
#                                               I N S E R T            #
#                                               R E M O V E            #
LOOPC2:    IBA = SCRECONBFAF[J] ; 
           CALLON ; 
           IF SCRECONCALOP[J] NQ 0
           THEN BEGIN 
            FOR K =0 STEP 1 UNTIL 6 DO
            BEGIN 
              IF B<K,1>SCRECONCALOP[J] EQ 1 THEN OUTTEXT(ONREC[K],7) ;
            END 
           END
           OUTSUB ; 
          IF SCRECNEXTON[J] THEN
            BEGIN 
              J = J + 1;
              GOTO LOOPC2;
            END 
         END
      C<L,1>OUTWRD = "." ;
      OUTENT ;
       STDNO ;
RELNAME:     #     ***     R E L N A M E     ***                       #
#**********************************************************************#
#   MOVES THE RELATION NAME INTO THE OUTPUT BUFFER ALONG WITH THE      #
#   CORRECPONDING DDL SYNTAX, AND THEN PRINTS IT OUT.                  #
#**********************************************************************#
      IF COMFLAG THEN              # IF COMMENT FLAG STILL ON,         #
        BEGIN 
        C<L,2>OUTWRD = "*/";       # END COMMENT.    #
        OUTENT; 
        COMFLAG = FALSE;
        END 
      C<L,9>OUTWRD = "RELATION "; 
      L = L + 9;
      C<L,8>OUTWRD = "NAME IS ";
      L = L + 8;
      I = SCRELNAMLENC[0];
      C<L,I>OUTWRD = C<0,I>SCRELNAM30[0];  # OUTPUT RELATION NAME.     #
      IF CLASFLAG EQ 1 THEN 
      BEGIN 
        OUTSUB; 
        STDNO;
        END 
      OUTENT; 
      STDYES; 
RELCLAUSE:   #     ***     R E L C L A U S E     ***                   #
#**********************************************************************#
#   EXHIBIT CLAUSES OF A RELATION ENTRY.                               #
#**********************************************************************#
      J = (SCRELMAXRANK[0]-2) * 2 + 2;   # NUMBER OF DBIS IN PRESENT   #
                                         # RELATION ENTRY.             #
      M = J * 2 + 2 + SCRELNAMLENW[0];   # NUMBER OF WORDS IN ENTRY # 
      IF M GR SZ THEN 
        BEGIN 
        K = M;
        CHECKBUF(K);
        EXREAD( WORKBUF, K, CURRENT );
        END 
      C<L,10>OUTWRD = "JOIN WHERE"; 
      OUTLINE;
      K = 2 + SCRELNAMLENW[0];     # SET POINTER TO START OF DBI ENTRY #
      K = K + 1;                   # SET TO SECOND WORD OF DBI ENTRY.  #
      FOR I = I WHILE J GR 0 DO 
        BEGIN    # BEGIN OF FOR LOOP--1  #
        L = L - 1;
        IF SCRLDBICONKY[K] THEN        # OUTPUT DBI NAME. # 
          OUTITM( SCRLDBIADR[K],1 );
        ELSE
          OUTITM( SCRLDBIADR[K],0 );
        IF SCRLDBIANYFG[K] THEN 
          OUTTEXT("(ANY)",5); 
        IF SCRLDBISUBCT[K] GR 0 THEN
          BEGIN 
          OUTTEXT( "(",1);
          N = SCRLDBISUBCT[K];
          FOR I = 22 STEP 12 WHILE N GR 0 DO
            BEGIN                  # OUTPUT SUBSCRIPTS. # 
            N = N - 1;
            M = B<I,12>SCRLDBISUBS[K];
            OUTINT( M );
            IF N NQ 0 THEN
              OUTTEXT( ",",1 ); 
            END 
          OUTTEXT( ")",1 ); 
          END 
          IF SCRLDBIQUAL[K] THEN
            BEGIN                  # OUTPUT QUALIFIER NAME. # 
            OUTTEXT(" IN ",4);
            OUTREC( RELPRADR ); 
            END 
          OUTLINE;
          IF B<59,1>J EQ 0 THEN 
            BEGIN 
            L = L - 1;
            C<L,2>OUTWRD = "EQ";
            OUTLINE;
            END 
          ELSE
            IF J NQ 1 THEN   # SEPARATE JOIN CLAUSES WITH A BLANK      #
              OUTLINE;       # LINE.                                   #
        J = J - 1;
        K = K + 2;
        END      # END OF FOR LOOP-- 1 #
      C<5,1>OUTWRD = "."; 
      OUTENT; 
      STDYES; 
  SAVNAM:  #  ***   S A V N A M    $$$   #
 #********************************************************************# 
#   SAVES THE ITEM NAME (CURWORD) IN THE SCRATCHBUF                    #
#   IN CASE OF A QUALIFIED ITEM                                        #
#**********************************************************************#
          SBITS[0] = CURLENG ;
          C<0,CURLENG>SCRWRD[1]  = C<0,CURLENG>CURWORD[0]  ;
      FOR I = 0 STEP 1 UNTIL CURLENW DO 
        SCRWRD[1+I] = CURWORD[I]; 
      STDNO ; 
      SEARCHRI:                    # ***  S E A R C H R I    ***       #
#**********************************************************************#
#   SEARCHES A RECORD IN ORDER TO OBTAIN ITS ITEMS                     #
#**********************************************************************#
      TYPE =RECORD ;
  SEARCH:        #       ***    S E A R C H    ***                     #
#**********************************************************************#
#   SEARCHES SCHEMA TO FIND NEXT AREA NAME. MOVES INTO WORKBUF NEXT    #
#   AREA ENTRY.  RETURN STDYES IF ENTRY TYPES MATCH, ELSE STDNO.       #
#   SEARCH RECORD ENTRIES AS WELL AS AREA ENTRIES                      #
#**********************************************************************#
      IF ENTRYTYPE[0] EQ AREA THEN  K =SCAREAENTRYL[0] ;
        ELSE IF ENTRYTYPE[0] EQ RECORD THEN K=SCRECENTLEN[0] ;
        ELSE STDNO ;
      K = K +NEXTENT; 
      IF ( K EQ LIMIT)
        THEN NEXTENT=0; 
        ELSE NEXTENT=K; 
      IF ENTRYTYPE[0] EQ TYPE THEN STDYES ; 
        ELSE BEGIN
          IF NEXTENT EQ 0 THEN STDNO; 
          EXREAD(WORKBUF,SZ,NEXTENT) ;
          CURRENT = NEXTENT;
          PTRIT=0;
          GOTO SEARCH;
        END 
                                                                         BB 
   SEARCHCS:       #  ***    S E A R C H C S    ****                   # AV 
#**********************************************************************# AV 
#     CHECKS IF CONSTRAINT ENTRIES PRESENT IN SCHEMA DIRECTORY         # AX 
#     RETURN IS TO STDNO IF CONSTRAINT ENTRIES ARE NOT PRESENT.        # AX 
#     RETURN IS TO STDYES IF CONSTRAINT ENTRIES ARE PRESENT.           # AX 
#                                                                      # AX 
#**********************************************************************# AX 
                                                                         AX 
      IF SCCWCITWA[0] EQ 0                  # NO CONSTRAINT ENTRIES    # BG 
      THEN STDNO;                                                        AX 
      STDYES;                                                            AX 
                                                                         AV 
  SEARCHCSTR:      #  ***    S E A R C H C S T R    ***                # AV 
#**********************************************************************# AV 
#     SEARCH SCHEMA DIRECTORY FOR NEXT CONSTRAINT ENTRY.               # AX 
#     IF THE SEARCH IS SUCCESSFUL, RETURN IS TO STDYES. ELSE STDNO.    # AX 
#                                                                      # AX 
#**********************************************************************# AX 
                                                                         AX 
      IF PTRIT EQ 0                                                      AX 
      THEN BEGIN                                                         AX 
           PTRIT = SCCWCITWA[0];                                         BG 
           EXREAD( WORKBUF, SZ, PTRIT);                                  AX 
           END                                                           AX 
      ELSE BEGIN                                                         AX 
           IF SCCSCITORD[0] EQ SCCWCSNUM[0] # LAST ENTRY FOUND         # BG 
           THEN BEGIN                                                    AX 
                PTRIT = 0;                                               AX 
                STDNO;                                                   AX 
                END                                                      AX 
           PTRIT = PTRIT + SCCSENTLEN[0];                                AX 
           EXREAD( WORKBUF, SZ, PTRIT);                                  AX 
           END                                                           AX 
      CURRENT = PTRIT;                                                   AX 
      STDYES;                                                            AX 
                                                                         AV 
  SEARCHENTRY:   #       ***    S E A R C H E N T R Y    ***           #
#**********************************************************************#
#     IF THE TYPE IS ITEM, DE$DISC IS CALLED TO LOCATE IT IN THE       # AT 
#     SCHEMA DIRECTORY.                                                # AT 
#     IF THE TYPE IS EITHER AREA, CONSTRAINT, RELATION OR RECORD       # AT 
#     DE$NMSC IS CALLED.                                               # AT 
#     IN EITHER CASE IF THE ENTRY IS FOUND, RETURN IS TO STDYES,       # AT 
#     ELSE RETURN IS TO STDNO.                                         # AT 
#     THE ENTRY WORD ADDRESS IS RETURNED IN DAENTAD[DITPTR] FOR        # AT 
#     BOTH CASES.                                                      # AT 
#                                                                      # AT 
#**********************************************************************#
      DAENTAD[DITPTR] = 0;
      IF TYPE EQ ITM                             # TYPE IS ITEM        # AT 
      THEN BEGIN                                                         AT 
           DE$DISC(DITSC,0,CWORD,CURLENW,SZ,WORKBUF);                    AT 
           CURITM = DAENTAD[DITPTR];                                     AT 
           END                                                           AT 
      ELSE BEGIN                                 # TYPE IS NOT ITEM    # AU 
           IF TYPE EQ AREA                                               AT 
              OR TYPE EQ CONSTRAINT                                      AT 
              OR TYPE EQ RELATION                                        AT 
           THEN I = 3;                                                   AT 
           ELSE I = 1;                                                   AT 
           DE$NMSC(DITSC,I,CWORD,CURLENW,SZ,WORKBUF);                    AT 
           CURRENT = DAENTAD[DITPTR];                                    AT 
           END                                                           AT 
      IF DASTATE[DITPTR] EQ 1                    # ENTRY NOT FOUND     # AT 
      THEN STDNO;                                                        AT 
      STDYES;                                                            AT 
                                                                         AT 
  SEARCHI:  #  *** S E A R C H I     ***    # 
 #********************************************************************# 
#   SEARCHES ITEMS IN A RECORD                                         #
#**********************************************************************#
      IF PTRIT EQ 0 
        THEN BEGIN
          IF SCRECDITMPTR[0] EQ 0 THEN STDNO; 
          PTRIT = SCRECDITMPTR[0] + CURRENT;
          EXREAD(WORKBUF,SZ,PTRIT) ;
          CURITM =PTRIT ; 
          STDYES; 
        END 
        ELSE BEGIN
          IF      SCITEMNXTPTR[0] EQ 0 THEN BEGIN PTRIT=0;STDNO; END
          PTRIT = SCITEMNXTPTR[0] + PTRIT ; 
          EXREAD(WORKBUF,SZ,PTRIT) ;
          CURITM =PTRIT ; 
          STDYES ;
        END 
      STDNO ; 
  SEARCHNXT:    #  ***  S E A R C H N X T    ***# 
 #********************************************************************# 
#   SEARCHES ALL ENTRIES AND DETERMINES THE ENTRY TYPE                 #
#**********************************************************************#
      IF PTRIT EQ 0 
        THEN BEGIN
          IF NEXTENT EQ 0 OR NEXTENT EQ LIMIT THEN STDNO; 
          EXREAD(WORKBUF,SZ,NEXTENT) ;
  SEARCHFST:  #  ***  S E A R C H F S T    ***  # 
 #********************************************************************# 
          TYPE = ENTRYTYPE[0] ; SWANY =0 ;
          IF TYPE EQ AREA THEN  K = SCAREAENTRYL[0] ; 
          IF TYPE EQ RECORD THEN K = SCRECENTLEN[0];
          CURRENT=NEXTENT ; 
          PTRIT=0 ; 
         NEXTENT = K+ NEXTENT ; 
          IF TYPE EQ RECORD THEN
            BEGIN 
              SWANY = 1;
              IF SCRECDITMPTR[0] EQ 0 THEN
                PTRIT = 0;
              ELSE
                PTRIT = SCRECDITMPTR[0] + CURRENT;
            END 
        END 
        ELSE BEGIN
          EXREAD(WORKBUF,SZ,PTRIT) ;
         CURITM = PTRIT ; 
          K = SCITEMNXTPTR[0] ; 
          IF  K EQ 0 THEN PTRIT =0 ;
                     ELSE PTRIT =K+PTRIT ;
          SWANY =2; 
        END 
        STDYES ;
  SEARCHQI:   #   ***   S E A R C H Q I     ***#
 #********************************************************************# 
#   SEARCHES A QUALIFIED ITEM ENTRY                                    #
#   THE ITEM NAME WAS SAVED IN THE SCRATCHBUF                          #
#**********************************************************************#
      I = 1;
      DAENTAD[DITPTR] = 0;
      DE$NMSC(DITSC,I,CWORD,CURLENW,SZ,WORKBUF);
      IF DASTATE[DITPTR] EQ 1 THEN
        STDNO;
      CURRENT = DAENTAD[DITPTR];   # ITEM WORD ADDRESS #
      LL =SBITS[0] ;
      IF SCRECDITMPTR[0] EQ 0 THEN
        STDNO;
      PTRIT = SCRECDITMPTR[0] + CURRENT;
QLOOP:EXREAD(WORKBUF,SZ,PTRIT) ;
         CURITM = PTRIT ; 
      IF LL EQ SCITMNAMLENC[0] THEN 
        BEGIN 
          IF C<0,LL>SCITMNAM30[SCITMNAMEPTR[0]] EQ C<0,LL>SCRWRD[1] 
            THEN STDYES;
        END 
      IF SCITEMNXTPTR[0] NQ 0 THEN
        BEGIN 
          PTRIT = SCITEMNXTPTR[0] + PTRIT;
          GOTO QLOOP; 
        END 
      PTRIT=0 ; 
      STDNO ; 
SEARCHREL:   #     ***     S E A R C H R E L     ***                   #
#**********************************************************************#
#   SEARCHES FOR RELATION ENTRIES.                                     #
#**********************************************************************#
      IF PTRIT EQ 0 THEN
        BEGIN 
        PTRIT = SCCWRELADDR[0]; 
        EXREAD( WORKBUF, SZ, PTRIT ); 
        END 
      ELSE
        BEGIN 
        IF SCRELNEXTPTR[0] EQ 0 THEN
          BEGIN 
          PTRIT = 0;
          STDNO;
          END 
        PTRIT = PTRIT + SCRELNEXTPTR[0];
        EXREAD( WORKBUF, SZ, PTRIT ); 
        END 
      CURRENT = PTRIT;
      STDYES; 
SEARCHRL:    #     ***     S E A R C H R L     ***                     #
#**********************************************************************#
#   CHECKS IF RELATION ENTRIES PRESENT IN SCHEMA DIRECTORY. IF SO,     #
#   RETURN IS TO STDYES, ELSE TO STDNO.                                #
#**********************************************************************#
      NEXTENT = 0;
      EXREAD( WORKBUF, CWSZ, NEXTENT ); 
      IF SCCWRELADDR[0] EQ 0 THEN 
        STDNO;
      STDYES; 
  SETALL:        #       ***    S E T A L L    ***                     #
#**********************************************************************#
#   SETS THE ALL FLAG WHICH INDICATES EITHER ALL NAMES OR ALL CLAUSES  #
#   SHOULD BE SOUGHT FOR THE EXCUTING EXHIBIT RUN. RETURN IS TO STDNO. #
#**********************************************************************#
      ALLFLAG = 1;
      STDNO;
  SETALLS:    #   ***   S E T A L L S    ***    # 
 #********************************************************************# 
#   SET THE ALLSFLAG WHEN THE ALL-ENTRIES OPTION IS ASKED              #
#   AND EXHIBIT THE CONTROL INFORMATION OF THE DIRECTORY               #
#   THEN READS THE FIRST NON-SCHEMA ENTRY                              #
#**********************************************************************#
      EFLAG = 1;
      ALLSFLAG = 1 ;
      C<L,2>OUTWRD= "/*" ;
      OUTENT ;
      C<L,19>OUTWRD = " NUMBER OF AREAS   " ;  L =L+19 ;
      K = SCCWNUMAREAS[0];
      OUTINT(K) ; 
      OUTENT ;
      C<L,19>OUTWRD = " NUMBER OF RECORDS " ;  L =L+19 ;
      K = SCCWNUMRECDS[0];
      OUTINT(K) ; 
      OUTENT ;
      C<L,19>OUTWRD = " NUMBER OF ITEMS   " ;  L =L+19 ;
      K = SCCWNUMITEMS[0];
      OUTINT(K) ; 
      OUTENT ;
      C<L,19>OUTWRD = " NO OF CONSTRAINTS "; L = L+19;                   AT 
      K = SCCWCSNUM[0];                                                  AT 
      OUTINT(K);                                                         AT 
      OUTENT;                                                            AT 
      C<L,19>OUTWRD = " NUMB OF RELATIONS "; L=L+19;
      K = SCCWNUMRELTN[0];
      OUTINT(K) ; 
      OUTENT ;
      C<L,19>OUTWRD = " NUMB OF ITEM-PROCS" ;  L=L+19;
      K = SCCWNMITMPRC[0];
      OUTINT(K) ; 
      OUTENT ;
      C<L,2>OUTWRD = "*/" ; 
      OUTENT ;
      EXREAD(WORKBUF,5,CWSZ+1);    # READ IN SCHEMA HEADER #
      OUTSCHEMA;
      CHECKBUF(SZ); 
      EXREAD(WORKBUF,SZ,FSTENT);   # READ IN FIRST SCHEMA ENTRY # 
      STDNO;
   SETAREA:    #     ***     S E T A R E A     ***                     #
#**********************************************************************#
#   SETS THE TYPE CELL TO THE VALUE OF AREA. TYPE IS USED AS A COMPARE #
#   FACTOR WHEN SEARCHING THROUGH THE DIRECTORY. RETURN IS TO STDNO.   #
#**********************************************************************#
      EFLAG = 1;
      TYPE = AREA;
      STDNO;
  SETCLAUSES:    #    ***    S E T C L A U S E S    ***                #
#**********************************************************************#
#   SETS THE CLAUSE FLAG TO INDICATE CLAUSES ARE TO BE EXHIBITED, RET- #
#   URN IS TO STDNO.                                                   #
#**********************************************************************#
      CLASFLAG = 1; 
      STDNO;
                                                                         AT 
   SETCSTR:        #  ***    S E T C S T R    ***                      # AV 
#**********************************************************************# AT 
#     SETS THE TYPE CELL TO THE VALUE OF CONSTRAINT. TYPE IS USED      # AT 
#     AS A COMPARE FACTOR WHEN SEARCHING THROUGH THE DIRECTORY.        # AT 
#     RETURN IS TO STDNO.                                              # AT 
#                                                                      # AT 
#**********************************************************************# AT 
                                                                         AT 
      EFLAG = 1;                                                         AT 
      TYPE = CONSTRAINT;                                                 AT 
      STDNO;                                                             AT 
                                                                         AT 
   SETITEM:     #     ***     S E T I T E M     ***                    #
#**********************************************************************#
#   SETS THE TYPE CELL TO THE VALUE OF ITEM.  TYPE USED TO COMPARE     #
#   FACTOR WHEN SEARCHING THROUGH THE DIRECTORY.  RETURN TO STDNO.     #
#**********************************************************************#
      EFLAG = 1;
      TYPE = ITM ;
      STDNO;
  SETONLY:    #     ***     S E T O N L Y     ***                     # 
#*********************************************************************# 
#   FOR RECORD ENTRY SETS ONLY FLAG SO THAT ONLY THE ASSOCIATED#
#   CLAUSES WILL BE DISPLAYED, RETURN TO STDNO                         #
#*********************************************************************# 
      ONLYFLAG = 1; 
    STDNO;
SETRECD:     #     ***     S E T R E C D     ***                       #
#**********************************************************************#
#   SETS SEARCH TYPE TO RECORD.                                        #
#**********************************************************************#
      EFLAG  = 1; 
      TYPE = RECORD ; 
      STDNO;
SETREL:      #     ***     S E T R E L    ***                          #
#**********************************************************************#
#   SETS THE SEARCH TYPE TO RELATION.                                  #
#**********************************************************************#
      EFLAG =1 ;
      TYPE = RELATION;
      STDNO;
STRTSC:     #     ***     S T R T S C     ****                         #
#**********************************************************************#
#   MOVES INTO WORKBUF FIRST SCHEMA ENTRY                              #
#**********************************************************************#
      NEXTENT = CWSZ ;
      ALLFLAG=0 ; 
      ALLSFLAG=0 ;
      ONLYFLAG =0;
      TYPE=0; 
      SWANY=0;
      LL=0; 
      LP=0; 
      CLASFLAG = 0; 
      FSTENT = SCCWFRSTAREA[0];         # FIRST AREA ENTRY ADDRESS #
      NEXTENT=FSTENT ;
      CURRENT=FSTENT ;
      PTRIT =0 ;
      EXREAD(WORKBUF,SZ,FSTENT);   # READ IN HEADER WORDS OF FIRST     #
                                   # SUB-ENTRY.                        #
      STDNO;
  
  PROC CHECKBUF(NUMWORDS);   #  ***   C H E C K B U F   ***            #
#**********************************************************************#
#   CHECKS THE AVAILABILITY OF MEMORY FOR THE SPECIFIED NUMBER OF      #
#   WORDS. ABORTS IF THERE IS NOT SUFFICIENT WORKING STORAGE AREA.     #
#**********************************************************************#
    BEGIN 
      ITEM NUMWORDS;         # NUMBER OF WORDS TO BE CHECKED #
      XREF PROC ABRT1;       # PROC TO ABORT DDL(IN CTLIO - 0,0 OVER.  #
      IF NUMWORDS GR AVAILMEM THEN
        ABRT1;               # SUFFICIENT WSA NOT AVAILABLE # 
    END 
  PROC CLEARWRD;  #      ***   C L E A R W R D :   ***                # 
#**********************************************************************#
#   BLANKS OUT THE CELL OUTWRD TO BE USED FOR ANOTHER LINE OF OUTPUT   #
#   BY DDLPRNT.                                                        #
#**********************************************************************#
      OUTWRD = "                                                  ";
  PROC CALLON ;  #    ***    C A L L O N    ***                        #
#**********************************************************************#
#  PRINTS OUT THE NAME OF THE PROCEDURE TO BE CALLED,LOCATED IN J      #
#  CONDITION BEFORE-AFTER IS IN IBA                                    #
#**********************************************************************#
      BEGIN 
        C<L,5>OUTWRD ="CALL " ; 
        L=L+5 ; 
        C<0,7>NAME = C<0,7>SCAREAONNAME[J] ;
        OUTNAME(7) ;
        IF B<0,1>IBA EQ 1 THEN OUTTEXT(" ERROR",6) ;
        IF B<1,1>IBA EQ 1 THEN OUTTEXT(" BEFORE",7) ; 
        IF B<2,1>IBA EQ 1 THEN OUTTEXT(" AFTER",6) ;
      END 
                                       # *** O U T A R N   ***         #
#**********************************************************************#
#   READS AN ENTRY IN SCRATCHBUF AND OUTPUT THE AREA NAME              #
#**********************************************************************#
      PROC OUTARN(KADDR); 
      BEGIN 
      DEF ARFIXWRDS #3#;
        ITEM KADDR,LL ; 
          EXREAD(SCRATCHBUF,20,KADDR) ; 
          LL = B<6,6>SBITS[0] ; 
          IF (L+LL) GQ 50 THEN OUTLINE ;
          C<L,LL>OUTWRD = C<0,LL>AREANAME[ARFIXWRDS]; 
          L=L+LL ;
      END 
                                       #  *** O U T D B I   ***        #
#**********************************************************************#
#   READS IN SCRATCHBUF THE ITEM ENTRIES OF THE CURRENT RECORD IN ORDER#
#   TO FIND AN ITEM OF A GIVEN ORDINAL AND OUTPUT ITS NAME             #
#**********************************************************************#
   PROC OUTDBI(KORD); 
      BEGIN 
      DEF ITMORDNUM #B<42,18>SBITS[0]#;  # ITEM ORDINAL NUMBER #
      DEF ITMNEXTPT #B<42,18>SBITS[3]#;  # NEXT ITEM POINTER #
      DEF ITMPRPTR  #B<0,18>SBITS[3]#;   # PRIOR ITEM POINTER # 
      DEF ITMNAMPTR #B<15,6>SBITS[6]#;   # OFFSET POINTER TO ITEM NAME #
        ITEM KORD ; 
        ITEM CORD,KAD ; 
          ITEM KSIG I;
          ITEM CUR ;
          CUR=CURITM ;
        CORD = SCITMORDNUM[0] ; 
        IF KORD EQ CORD 
           THEN BEGIN 
             LL = SCITMNAMLENC[0] ; 
              IF (L+LL) GQ 50 THEN OUTLINE ;
             C<L,LL>OUTWRD = C<0,LL>BUFWRD[ITMNAMPTR];
             L =L+LL ;
           END
           ELSE BEGIN 
            IF KORD LS CORD 
            THEN BEGIN
              KSIG = -1 ; 
              KAD  = SCITEMPRIORP[0] ;
            END 
            ELSE BEGIN
              KSIG = +1 ; 
              KAD  = SCITEMNXTPTR[0] ;
            END 
OUTLP:      IF KAD EQ 0 THEN RETURN ; 
              ELSE  KAD = CUR +KSIG*KAD ; 
            EXREAD(SCRATCHBUF,10,KAD) ; 
            CUR=KAD ; 
            IF KORD NQ ITMORDNUM THEN 
              BEGIN 
              IF KSIG EQ 1 THEN 
                KAD = ITMNEXTPT;
              ELSE
                KAD = ITMPRPTR; 
              GOTO OUTLP; 
              END 
            ELSE
              BEGIN 
              LL = B<6,6>SBITS[0];
              IF (L+LL) GQ 50 THEN OUTLINE; 
              C<L,LL>OUTWRD = C<0,LL>AREANAME[ITMNAMPTR]; 
              L = L + LL; 
              RETURN; 
              END 
           END
      END 
                                       #  ***  O U T L I T   ***       #
#**********************************************************************#
#   OUTPUT A LITERAL LEFT JUSTIFIED,ZERO FILLED,LESS THAN 255 CHARS.   #
#**********************************************************************#
      PROC OUTLIT(LITLENG); 
      BEGIN 
        ITEM LITLENG; 
        ITEM L1,L2,L3,L4; 
        L1 = LITLENG; 
        FOR L2 = (LITLENG-1) STEP -1 UNTIL 0 DO 
          IF B<L2*6,6>NAME EQ 0 THEN
            L1 = L2;
        IF L1 EQ 0 THEN 
          RETURN; 
        ELSE
          L3 = 0; 
LITLOOP:  #  #
        IF L GQ LN THEN OUTLINE;
        IF L1 GQ (LN-L) THEN
          L4 = LN - L;
        ELSE
          L4 = L1;
        C<L,L4>OUTWRD = C<L3,L4>NAME; 
        L = L + L4; 
        L3 = L3 + L4; 
        L1 = L1 - L4; 
        IF L1 GR 0 THEN 
          GOTO LITLOOP; 
      END 
                                       #  ***  O U T I N T    ***      #
#**********************************************************************#
#   EDIT AND OUTPUT AN INTEGER POSITIVE OR NEGATIVE LESS THAN          #
#   10 CHARACTERS LONG                                                 #
#**********************************************************************#
      PROC OUTINT(KINT)  ;
      BEGIN 
        ITEM KINT,KNB,IX,IY,IZ; 
        ITEM CTEMP C(10) ;
        CTEMP="         0" ;
        IF KINT EQ 0 THEN KNB =2 ;
                     ELSE KNB =1 ;
        IF KINT LS 0 THEN IY=-KINT ;
                     ELSE IY=KINT ; 
      FOR IZ=54 STEP -6 WHILE IY GR 0 DO
      BEGIN 
        IX=IY/10 ;
        B<IZ,6>CTEMP=IY-IX*10+O"33" ; 
        KNB=KNB+1 ; 
        IY=IX;
      END 
        IF KNB GR 10 THEN KNB=10 ;
        IF (L+KNB) GQ LN THEN OUTLINE ; 
        C<L,KNB>OUTWRD = C<(10-KNB),KNB>CTEMP ; 
        IF KINT LS 0 THEN C<L,1>OUTWRD= "-" ; 
        L=L+KNB+1 ; 
      END 
                                       #  *** O U T I T M   ***        #
#**********************************************************************#
#   READS IN SCRATCHBUF AN ITEM ENTRY AND OUTPUT THE ITEM NAME         #
#**********************************************************************#
      PROC OUTITM(KADDR,KTYPE); 
      BEGIN 
        ITEM KADDR,LL ; 
        ITEM KTYPE;          # 0 = ITEM NAME,                          #
                             # 1 = CONCATENATED KEY NAME.              #
        ITEM WRDADR;
          IF (L+1) GQ 50 THEN OUTLINE ; 
          C<L,1>OUTWRD = " " ;
          L=L+1 ; 
          EXREAD(SCRATCHBUF,20,KADDR) ; 
          IF KTYPE EQ 0 THEN
          BEGIN 
          WRDADR = 7;        # NUMB OF FIXED WORDS IN ITEM ENTRY #
          LL=B<6,6>SBITS[0] ; 
          END 
          ELSE                     # CONCATENATED KEY NAME #
            BEGIN 
            WRDADR = 3; 
            LL = B<40,5>SBITS[2];  # NUMBER OF CHARS IN KEY NAME #
            END 
          IF (L+LL) GQ 50 THEN OUTLINE ;
          C<L,LL>OUTWRD = C<0,LL>AREANAME[WRDADR];
          L=L+LL ;
          IF KTYPE EQ 0 THEN
          RELPRADR = B<42,18>SBITS[6]; # STORE RECORD ADDRESS # 
      END 
                                       #  ***   O U T L I N E    ***   #
#**********************************************************************#
  PROC OUTLINE ;
      BEGIN 
        L=10 ;
OUTL: 
        DDLPRNT(OUTWRD,50); 
        CLEARWRD ;
        RETURN ;
      ENTRY PROC OUTENT ; 
        L=1 ; 
        GOTO OUTL ; 
      ENTRY PROC OUTSUB ; 
        L=5 ; 
        GOTO OUTL ; 
      END 
                                   #***  O U T N A M E     ***         #
#**********************************************************************#
#  OUTPUT A NAME LEFT JUSTIFIED,ZERO FILLED,LESS THAN 240 CHARS LONG   #
#**********************************************************************#
      PROC OUTNAME(LL); 
      BEGIN 
        ITEM LL;
        ITEM NI,NJ,NK,NL ;
        NJ=LL ; 
        FOR NI=(LL-1) STEP -1 UNTIL 0 DO
          IF B<NI*6,6>NAME EQ 0 THEN NJ=NI ;
        IF NJ EQ 0 THEN RETURN ; ELSE NL=0 ;
LOOP:   IF (L+NJ) GQ LN THEN OUTLINE ;
        IF NJ GQ (LN-10) THEN NK = LN-10 ;
                         ELSE NK = NJ  ;
        C<L,NK>OUTWRD = C<NL,NK>NAME ;
        L = L+NK ;
        NL= NL+NK ; 
        NJ= NJ-NK ; 
        IF NJ GR 0 THEN GOTO LOOP ; 
      END 
                                       #  ***  O U T R E C   ***       #
#**********************************************************************#
#   READS IN SCRATCHBUF A RECORD ENTRY AND OUTPUT THE RECORD NAME      #
#**********************************************************************#
      PROC OUTREC(KADDR); 
      BEGIN 
        DEF RECFIXWD #3#;    # NUMBER OF FIXED WORDS IN RECORD ENTRY #
        ITEM KADDR,LL ; 
          EXREAD(SCRATCHBUF,20,KADDR) ; 
          LL=B<6,6>SBITS[0] ; 
          IF (L+LL) GQ 50 THEN OUTLINE ;
          C<L,LL>OUTWRD = C<0,LL>AREANAME[RECFIXWD];
          L=L+LL ;
      END 
                                       #  ***  O U T S C H E M A ***   #
#**********************************************************************#
#   EXHIBIT THE SCHEMA ENTRY WHICH IS IN BUFWRD                        #
#**********************************************************************#
  PROC OUTSCHEMA ;
      BEGIN 
#            ----   S C H E M A    SCHEMANAME                          #
      C<L,7>OUTWRD = "SCHEMA " ;
      L=L+7 ; 
      LL = SCHNAMLENGC[0] ; 
      C<L,LL>OUTWRD = C<0,LL>BUFWRD[1] ;
      OUTSUB ;
#            ----   C A L L  PROC  E R R O R      L O C K S            #
#                                  B E F O R E    D I S P L A Y        #
#                                  A F T E R      C O P Y              #
#                                                 A L T E R            #
      C<L,1>OUTWRD = "." ;
      OUTENT ;
      C<L,2>OUTWRD= "/*" ;
      OUTENT ;
      COMFLAG= TRUE ; 
      END 
                                   # *** O U T T E X T      ***        #
#**********************************************************************#
# PUT IN OUTWRD,STARTING ON CHAR L,A TEXT,LT CHARS LONG                #
#**********************************************************************#
      PROC OUTTEXT(TEXT,LT) ; 
      BEGIN 
        ITEM TEXT C(LN) ; 
        ITEM LT ; 
        IF (L+LT) GR LN THEN OUTLINE ;
        C<L,LT>OUTWRD = C<0,LT>TEXT  ;
        L=L+LT ;
      END 
  PROC PRIV;    #  ***   P R I V      ***                              #
#**********************************************************************#
#    PRINTS OUT ACCESS-CONTROL LITERAL AND/OR DBP.                     #
#**********************************************************************#
    BEGIN 
      DEF LTY #3#; # NO OF BITS IN LITERAL/DBP HEADER POSITION IN A WRD#
      DEF LWD #3#; # NO OF BITS IN LITERAL/DBP WORD LENGTH FIELD #
      DEF LCH #6#; # NO OF BITS IN LITERAL/DBP CHARACTER LENGTH FIELD # 
      K = SCHPRVALPTR[J] + J; # START OF LITERAL/DBP(LOCKS) LIST #
      M = 36;    # INITIALIZE TO START OF LOCK HEADERS(12 BIT HEADERS) #
      FOR I = M STEP 12 WHILE B<I,LTY>SCHEMALOCKWD[J] NQ 6 DO 
        BEGIN                # STEP THRU ACCESS-CONTROL LOCKS # 
          LL = B<I+LTY+LWD,LCH>SCHEMALOCKWD[J]; #LIT/DBP LENGTH IN CHAR#
          C<0,LL>NAME = C<0,LL>BUFWRD[K]; # STOR LIT/DBP #
          IF L+LL+2 GR LN THEN OUTLINE; 
          IF B<I,LTY>SCHEMALOCKWD[J] EQ 1 THEN
            BEGIN                  # LITERAL #
              OUTTEXT("""",1);
              OUTLIT(LL);          # OUTPUT LITERAL # 
              OUTTEXT("""",1);
            END 
          ELSE                     # DATA-BASE-PROCEDURE #
            BEGIN 
              OUTTEXT("PROCEDURE ",10); 
              OUTNAME(LL);         # OUTPUT DBP # 
            END 
          K = K + B<I+LTY,LWD>SCHEMALOCKWD[J];
          IF I GQ 48 THEN 
            BEGIN                  # END OF WORD - RESET POINTERS # 
              I = -12;
              J = J + 1;
            END 
          OUTTEXT(" OR ",4);
        END 
      L = L - 4;
      C<L,3>OUTWRD = "   "; # ERASE LAST "OR" # 
      J = K;   # START OF NEXT ACCESS-CONTROL ENTRY,IF ANY #
    END          # END OF PROC #
      END 
TERM
