*DECK DDLSS 
USETEXT CCTTEXT 
USETEXT DBTEXT
PROC DDLSS; 
CONTROL NOLIST ;
*CALL DEBUGVARS 
*CALL GETSET
*CALL PLT1
*CALL TABLNAMES 
*CALL PLTVALS 
*CALL CTXTVALS
*CALL,DBSAT 
CONTROL LIST ;
START("DDLSS")
 $BEGIN 
XREF ITEM DDLDEBUG B;  #DDL DEBUG#
 $END 
CONTROL IFNQ CB5$CDCS,"NO"; 
 $BEGIN 
  IF DDLDEBUG THEN DEBUGON
 $END 
ITEM  USEDDL  B  ;   # SET IF SUB-SCHEMA IS  SPECIFIED #
XDEF  BEGIN 
ITEM  CURAREA ; 
ITEM NUMRELS I;              #NUMBER OF RELATIONS#
ITEM CVALUE,CTYP ;
PROC DDLCTEXT;               #GENERATE CTEXT ATOM#
ITEM SLINE;   #SAVE THE SOURCE LINE NO #
ITEM SCOL;  # SAVE THE SSCANNER SOURCE COL NO # 
  
  
  END 
  
  
XDEF  BEGIN 
ITEM DATNAM  C(30); # DATANAME ,LEVEL,LINE NO AND LENGTH #
ITEM DALEV  I ; 
ITEM DALINE I;
ITEM DALEN I; 
ITEM OCCPT I; # POINTER TO THE OCCURS DATA IN THE ITEM ENTRY #
ITEM OCCADD I;  # ADDRESS OF THE INDEX NAME IN THE ITEM ENTRY # 
ITEM OCCLR I; # LEFT-RIGHT FLAG FOR INDEX PTRS #
ITEM OCCNXT B; # FLAG FOR -NEXT INDEX PTR IS USED,ELSE END- # 
ITEM OCCLEN  I; 
BASED ARRAY DATN[1:1];
BEGIN 
  ITEM DATNMC  C(0,0,10); 
  ITEM DATNM  U(0,0,60);
END 
END 
  
         CONTROL IFEQ CB5$CDCS,"CDCS1"; 
          ITEM AREALSTBUFSZ I;  #ACTUAL SIZE OF SS AREALIST#
         CONTROL FI;
  
XREF  BEGIN 
  PROC DDSSFDL; 
  PROC NXTASS;
  PROC NXTRSS;
  PROC NXTISS;
  PROC NXTIND;
  PROC NXTRLSS; 
  FUNC LJZF C(30) ; 
  PROC DNTBUILD ; 
  PROC DNTEXTRA ; 
  PROC DATSPACE ; 
  PROC CTOUTPUT;
  END 
  
# 
# 
  
XREF BEGIN
ARRAY STRINGAREA[0:25]; 
  ITEM SAREA C(0,0,10) ;
  
ITEM SAREALENGTH I ;
ITEM CLATYPE; 
ITEM CLAVALUE;
ITEM CLACOLUMN; 
ITEM CLALINE; 
ITEM LEVELNUMVALU;
ITEM DNTNEXT; 
ITEM CTEXTNEXT; 
ITEM PLTNEXT; 
ITEM PLSTNEXT  ;
ITEM MUSTSAVECTXT  B  ; 
END 
# 
# 
# 
 #
  
DEF DIAGNOS(SEV,NUM,LINE,COL) 
         #INTERCEPTOR(COL,LINE,NUM-1000,SEV)#;
DEF ERR1204  #1204#;
DEF ERR1207  #1207#;
PROC BUILDDNT ; 
START("BUILDDNT") 
  
                # SET UP THE PARAMETERS FOR DNTBUILD  # 
  
SETO("SAREA0",SAREA[0],DATNMC[1]) 
SETO("SAREA1",SAREA[1],DATNMC[2]) 
SETO("SAREA2",SAREA[2],DATNMC[3]) 
  
SETO("SAREALENGTH",SAREALENGTH,DALEN) 
SETO("CLALINE",CLALINE,DALINE)
SETO("LEVELNUMVALU",LEVELNUMVALU,DALEV) 
  
DNTBUILD ;
  
FINIS("BUILDDNT") 
# 
# 
  
PROC DDLCTEXT;
START("DDLCTEXT") 
  
                # SET UP THE PARAMETERS FOR  CTOUTPUT  #
  
XREF
BEGIN 
  ITEM CTTYPE ; 
  ITEM CTKEY; 
  ITEM CTCOLUMN;
  ITEM CTVALUE; 
END 
  
SETO("CTKEY",CTKEY,0) 
SETO("CTCOLUMN",CTCOLUMN,0) 
SETO("CTVALUE",CTVALUE,CVALUE)
SETO("CTTYPE",CTTYPE,CTYP)
  
      CTOUTPUT              ; 
  
FINIS("DDLCTEXT") 
CONTROL EJECT  ;
  
SETO("P<DATN>",P<DATN>,LOC(DATNAM) )
SETI("CURAREA",CURAREA,1) 
SETO("SLINE",SLINE,CLALINE) 
SETO("SCOL",SCOL,CLACOLUMN)    # SAVE SSCANNER LINE AND COL # 
SETO("CLACOLUMN",CLACOLUMN,0)       # FOR DDL DATANAMES  #
                              # THE DNTS ETC WILL USE THE LINE NO # 
                              # FROM THE SUB-SCHEMA AND COL=0  #
  
  
IF SSNUMAREAS NQ 0
THENB("SELECTED AREAS") 
DNTEXTRA;    # ENMPTY DNT ENTRY FOR DATABASE FILE SECTION  #
SETO("CCTDBFSCTXT",CCTDBFSCTXT,CTEXTNEXT)  #POINTER TO START OF CTEXT#
ENDIF 
  
 CONTROL IFEQ CB5$CDCS,"CDCS1"; 
SETO("AREALSTBUFSZ",AREALSTBUFSZ,(SBCWNUMAREAS[1]+SBCWNUMRELS[1])*4)
DA$GTSB(AREALIST,AREALSTBUFSZ,SBCWHASHADR[1]);  #READ SS AREALIST#
IF DASTATE NQ 0 
  THENB("ERROR IN READING AREALIST")
    DIAGNOS(0,ERR1207,0,253);  #253 INDICATES ERROR SS-RELATED# 
    QUIT
ENDIF 
 CONTROL FI;
  
  
IF SSNUMAREAS NQ 0
THENB("SELECTED AREAS AGAIN") 
LOOP("PROCESS AREAS ")
  NXTASS;  # GET NEXT AREA #
  EXITIF(AREA$F,EQ,1,"END OF SAT ") 
  SETO("CTYP",CTYP,CTDNREF) 
  SETO("CVALUE",CVALUE,DNTNEXT) 
  DDLCTEXT ;    # BUILD CTEXT FOR START OF DDL DNTS  #
  
  SETO("CTYP",CTYP,CTLITERAL) 
  SETO("CVALUE",CVALUE,AREALISTPTR) 
  DDLCTEXT;                  #BUILD CTEXT POINTING TO AREA ENTRY# 
  
  BUILDDNT;      # FOR FD    #
  
  
  
  LOOP("THROUGH RECORDS ")
    NXTRSS;  # GET NEXT RECORD #
    EXITIF(REC$F,EQ,1,"END OF RECORD AREAS ") 
  
  
    BUILDDNT;    # FOR RECORD ENTRY  #
  
  
  
  
      LOOP("THROUGH ITEMS ")
        NXTISS;  # GET NEXT ITEM #
        EXITIF(ITM$F,EQ,1,"END OF ITEMS ")
  
  
      BUILDDNT;     #  FOR ITEM ENTRIES # 
  
  
        IF OCCPT NQ 0 
          THENB("ITEM HAS INDEX") 
  
  
            LOOP("THROUGH INDICES") 
              NXTIND;  # GET NEXT INDEX # 
              BUILDDNT ;  # FOR INDEX # 
              EXITIF(OCCPT,EQ,0,"END OF INDICES") 
  
  
           ENDLOOP("MORE INDICES ") 
  
  
        ENDIF 
  
  
      ENDLOOP("MORE ITEMS") 
  
  
  ENDLOOP("MORE RECORDS") 
  
  SETO("CTYP",CTYP,CTDNREF) 
  SETO("CVALUE",CVALUE,DNTNEXT-1) 
  DDLCTEXT;  # CTEXT FOR END OF DNTS #
  
  
  
ENDLOOP("MORE AREAS") 
ENDIF 
  
DDSSFDL;                     #PROCESS CDCS FDLT INFORMATION#
  
  
 IV$($SET$,"NUMBER OF SS AREAS",SBCWNUMAREAS[1])
 SETI("NUMBER OF RELATIONS",NUMRELS,0)
 LOOP("THROUGH RELATIONS")
   NXTRLSS; 
   EXITIF(REL$F,EQ,1,"END OF RELATIONS")
   BUILDDNT;                 #FOR RELATION, SAME AS AREA# 
 ENDLOOP("MORE RELATIONS")
  
SETO("CLALINE",CLALINE,SLINE) 
SETO("CLACOLUMN",CLACOLUMN,SCOL)
                # RECOVER THE SSCANNER LINE AND COL NOS  #
  
 CONTROL IFEQ CB5$CDCS,"CDCS1"; 
     # IF A SS LOADER OMIT LIST#
     # READ THE -OMIT- LIST INTO THE AREA LIST SPACE THEN # 
     #COPY THAT TO THE PLT   #
IF SBCWOMITADDR[1] EQ 0 
THENB("NO SS OMIT LIST")
SETO("CCTPLTLOPTR",CCTPLTLOPTR,0) 
ELSEB("THERE IS A SS OMIT LIST")
SETO("CCTPLTLOPTR",CCTPLTLOPTR,PLTNEXT) 
IF AREALISTSIZE LS SBCWOMITLENG[1]
  THENB("OMIT TABLE EXCEEDS BUFFER")
  SETO("NEW OMIT LIST SIZE",SBCWOMITLENG[1],AREALISTSIZE) 
ENDIF 
DA$GTSB(AREALIST,SBCWOMITLENG[1],SBCWOMITADDR[1]);
 IF DASTATE EQ 1
    THENB("OMIT LIST READ ERROR") 
      DIAGNOS(0,ERR1204,0,253);  #253 INDICATES ERROR SS-RELATED# 
      SETO("CCTPLTLOPTR",CCTPLTLOPTR,0) 
      QUIT
    ENDIF 
SETO("OMITLIST WC",LDROMITWC[1],SBCWOMITLENG[1]-1)
SETFIELD(PL$LENGTH,PLT$,PLTNEXT,(SBCWOMITLENG[1]+1)*10);
SETFIELD(PL$CODE,PLT$,PLTNEXT,PLTDDLFIT); 
SETO("CCTPLSTLEN",CCTPLSTLEN,PLSTNEXT)
SETPLST(PLTNEXT,LOC(AREALIST) );
SETO("PLTNEXT",PLTNEXT,PLTNEXT+1) 
SETO("PLSTNEXT",PLSTNEXT,CCTPLSTLEN)
   # THE OMIT TABLE  HAS BENN COPIED TO THE PLT  #
ENDIF 
 CONTROL FI;
  
CONTROL FI; 
FINIS("DDLSS")
  
TERM
